code-blocks
(defun foo (&key radix (type 'integer)) ...)
(defun foo (&key ((:radix radix)) ((:type type) 'integer)) ...)
;;; The caller can supply :ALLOW-OTHER-KEYS T to suppress checking.
((lambda (&key x) x) :x 1 :y 2 :allow-other-keys t) → 1
;;; The callee can use &ALLOW-OTHER-KEYS to suppress checking.
((lambda (&key x &allow-other-keys) x) :x 1 :y 2) → 1
;;; :ALLOW-OTHER-KEYS NIL is always permitted.
((lambda (&key) t) :allow-other-keys nil) → T
;;; As with other keyword arguments, only the left-most pair
;;; named :ALLOW-OTHER-KEYS has any effect.
((lambda (&key x) x)
:x 1 :y 2 :allow-other-keys t :allow-other-keys nil)
→ 1
;;; Only the left-most pair named :ALLOW-OTHER-KEYS has any effect,
;;; so in safe code this signals a PROGRAM-ERROR (and might enter the
;;; debugger). In unsafe code, the consequences are undefined.
((lambda (&key x) x) ;This call is not valid
:x 1 :y 2 :allow-other-keys nil :allow-other-keys t)
(lambda (x y &aux (a (car x)) (b 2) c) (list x y a b c))
\EQ (lambda (x y) (let* ((a (car x)) (b 2) c) (list x y a b c)))
((lambda (a b) (+ a (* b 3))) 4 5) → 19
((lambda (a &optional (b 2)) (+ a (* b 3))) 4 5) → 19
((lambda (a &optional (b 2)) (+ a (* b 3))) 4) → 10
((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)))
→ (2 NIL 3 NIL NIL)
((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6)
→ (6 T 3 NIL NIL)
((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6 3)
→ (6 T 3 T NIL)
((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x)) 6 3 8)
→ (6 T 3 T (8))
((lambda (&optional (a 2 b) (c 3 d) &rest x) (list a b c d x))
6 3 8 9 10 11)
→ (6 t 3 t (8 9 10 11))
((lambda (a b &key c d) (list a b c d)) 1 2) → (1 2 NIL NIL)
((lambda (a b &key c d) (list a b c d)) 1 2 :c 6) → (1 2 6 NIL)
((lambda (a b &key c d) (list a b c d)) 1 2 :d 8) → (1 2 NIL 8)
((lambda (a b &key c d) (list a b c d)) 1 2 :c 6 :d 8) → (1 2 6 8)
((lambda (a b &key c d) (list a b c d)) 1 2 :d 8 :c 6) → (1 2 6 8)
((lambda (a b &key c d) (list a b c d)) :a 1 :d 8 :c 6) → (:a 1 6 8)
((lambda (a b &key c d) (list a b c d)) :a :b :c :d) → (:a :b :d NIL)
((lambda (a b &key ((:sea c)) d) (list a b c d)) 1 2 :sea 6) → (1 2 6 NIL)
((lambda (a b &key ((c c)) d) (list a b c d)) 1 2 'c 6) → (1 2 6 NIL)
((lambda (a &optional (b 3) &rest x &key c (d a))
(list a b c d x)) 1)
→ (1 3 NIL 1 ())
((lambda (a &optional (b 3) &rest x &key c (d a))
(list a b c d x)) 1 2)
→ (1 2 NIL 1 ())
((lambda (a &optional (b 3) &rest x &key c (d a))
(list a b c d x)) :c 7)
→ (:c 7 NIL :c ())
((lambda (a &optional (b 3) &rest x &key c (d a))
(list a b c d x)) 1 6 :c 7)
→ (1 6 7 1 (:c 7))
((lambda (a &optional (b 3) &rest x &key c (d a))
(list a b c d x)) 1 6 :d 8)
→ (1 6 NIL 8 (:d 8))
((lambda (a &optional (b 3) &rest x &key c (d a))
(list a b c d x)) 1 6 :d 8 :c 9 :d 10)
→ (1 6 9 8 (:d 8 :c 9 :d 10))
(defun array-of-strings (str dims &rest named-pairs
&key (start 0) end &allow-other-keys)
(apply #'make-array dims
:initial-element (subseq str start end)
:allow-other-keys t
named-pairs))
(:constructor create-foo
(a &optional b (c 'sea) &rest d &aux e (f 'eff)))
(defstruct (foo (:constructor CREATE-FOO (a &optional b (c 'sea)
&key (d 2)
&aux e (f 'eff))))
(a 1) (b 2) (c 3) (d 4) (e 5) (f 6))
(create-foo 10) → #S(FOO A 10 B 2 C SEA D 2 E implemention-dependent F EFF)
(create-foo 10 'bee 'see :d 'dee)
→ #S(FOO A 10 B BEE C SEE D DEE E implemention-dependent F EFF)
(create-foo 1 2)
(make-foo :a 1 :b 2)
(defstruct (frob (:constructor create-frob
(a &key (b 3 have-b) (c-token 'c)
(c (list c-token (if have-b 7 2))))))
a b c)
A<B<C<D<E<F<G<H<I<J<K<L<M<N<O<P<Q<R<S<T<U<V<W<X<Y<Z
a<b<c<d<e<f<g<h<i<j<k<l<m<n<o<p<q<r<s<t<u<v<w<x<y<z
0<1<2<3<4<5<6<7<8<9
either 9<A or Z<0
either 9<a or z<0
(defclass C1 ()
((S1 :initform 5.4 :type number)
(S2 :allocation :class)))
(defclass C2 (C1)
((S1 :initform 5 :type integer)
(S2 :allocation :instance)
(S3 :accessor C2-S3)))
(defclass pie (apple cinnamon) ())
(defclass apple (fruit) ())
(defclass cinnamon (spice) ())
(defclass fruit (food) ())
(defclass spice (food) ())
(defclass food () ())
(defclass new-class (fruit apple) ())
(defclass apple (fruit) ())
(defclass pie (apple cinnamon) ())
(defclass pastry (cinnamon apple) ())
(defclass apple () ())
(defclass cinnamon () ())
(defmacro foo (x) `(car ,x))
(eval-when (:execute :compile-toplevel :load-toplevel)
(print (foo '(a b c))))
(eval-when (:execute :compile-toplevel :load-toplevel)
(defmacro foo (x) `(car ,x))
(print (foo '(a b c))))
(typep \param{c} 'condition) → T
(apply #'make-condition \param{datum} \param{arguments})
(make-condition \param{defaulted-type}
:format-control \param{datum}
:format-arguments \param{arguments})
(let ((c (make-condition 'arithmetic-error :operator '/ :operands '(7 0))))
(error c))
\EQ (error 'arithmetic-error :operator '/ :operands '(7 0))
(error "Bad luck.")
\EQ (error 'simple-error :format-control "Bad luck." :format-arguments '())
(error "This is a message") ; Not recommended
(error "this is a message.") ; Not recommended
(error "This is a message.") ; Recommended instead
(error "This is a message.~%") ; Not recommended
(error "~&This is a message.") ; Not recommended
(error "~&This is a message.~%") ; Not recommended
(error "This is a message.") ; Recommended instead
(defun test ()
(error "This is an error message.~\%It has two lines."))
;; Implementation A
(test)
This is an error message.
It has two lines.
;; Implementation B
(test)
;; Error: This is an error message.
;; It has two lines.
;; Implementation C
(test)
>> Error: This is an error message.
It has two lines.
(evenp most-positive-fixnum) → implementation-dependent
(random) → implementation-dependent
(> lambda-parameters-limit 93) → implementation-dependent
(char-name #\A) → implementation-dependent
(defun foo ()
\#+ACME (acme:initialize-something)
(print 'hello-there))
% % (defun bar (x y) ;[1] 1st occurrence of x
% % (let ((old-x x) ;[2] 2nd occurrence of x
% % (x y)) ;[3] 3rd occurrence of x
% % (declare (special x))
% % (list old-x x)))
% %
% (let ((x 1)) ;[1] 1st occurrence of x
% (declare (special x)) ;[2] 2nd occurrence of x
% (let ((x 2)) ;[3] 3rd occurrence of x
% (let ((old-x x) ;[4] 4th occurrence of x
% (x 3)) ;[5] 5th occurrence of x
% (declare (special x)) ;[6] 6th occurrence of x
% (list old-x x)))) ;[7] 7th occurrence of x
% → (2 3)
%
% (lambda (&optional (x (foo 1))) ;[1]
% (declare (notinline foo)) ;[2]
% (foo x)) ;[3]
%
% (locally (declare (notinline foo)) ;[1]
% (lambda (&optional (x (foo 1))) ;[2]
% (foo x))) ;[3]
%
% (lambda (&optional ;[1]
% (x (locally (declare (notinline foo)) ;[2]
% (foo 1)))) ;[3]
% (declare (notinline foo)) ;[4]
% (foo x)) ;[5]
%
% (defun foo (x) ;[1]
% (if (typep x 'integer) ;[2]
% (list (let ((y (+ x 42))) ;[3]
% (declare (fixnum x y)) ;[4]
% y) ;[5]
% (+ x 42)) ;[6]
% `(foo ,x))) ;[7]
%
% (foo (- most-negative-fixnum 1))
%
% (defun foo (x) ;[1]
% (if (typep x 'integer) ;[2]
% (list (let ((y (+ x 42))) ;[3]
% (declare (fixnum x)) ;[4]
% x ;[5]
% y) ;[6]
% (+ x 42)) ;[7]
% `(foo ,x))) ;[8]
%
% (foo most-positive-fixnum)
%
% (defun foo (x) ;[1]
% (if (typep x 'integer) ;[2]
% (list (let ((y (the fixnum (+ x 42)))) ;[3]
% (declare (fixnum x y)) ;[4]
% x ;[5]
% y) ;[6]
% (+ x 42)) ;[7]
% `(foo ,x))) ;[8]
%
(let ((x 1)) ;[1] 1st occurrence of x
(declare (special x)) ;[2] 2nd occurrence of x
(let ((x 2)) ;[3] 3rd occurrence of x
(let ((old-x x) ;[4] 4th occurrence of x
(x 3)) ;[5] 5th occurrence of x
(declare (special x)) ;[6] 6th occurrence of x
(list old-x x)))) ;[7] 7th occurrence of x
→ (2 3)
(lambda (&optional (x (foo 1))) ;[1]
(declare (notinline foo)) ;[2]
(foo x)) ;[3]
(locally (declare (notinline foo)) ;[1]
(lambda (&optional (x (foo 1))) ;[2]
(foo x))) ;[3]
(lambda (&optional ;[1]
(x (locally (declare (notinline foo)) ;[2]
(foo 1)))) ;[3]
(declare (notinline foo)) ;[4]
(foo x)) ;[5]
(let ((x 1)) ;[1]
(declare (special x)) ;[2]
(let ((x 2)) ;[3]
(dotimes (i x x) ;[4]
(declare (special x))))) ;[5]
→ 1
(x y)
(x B A C y)
(x A B B B B B C y)
(x C B A B B B y)
(x B B A A C C y)
(x C B C y)
(x B y)
(x B A C y)
(x A B B B B B C y)
(x C B A B B B y)
(x y)
(x B B A A C C y)
(x C B C y)
(x A B C y)
(x A C B y)
(x A B y)
(x B A C y)
(x B C A y)
(x B A y)
(x C A B y)
(x C B A y)
(+ 4 5) → 9
(truncate 7 5)
→ 1 2
(truncate 7 5)
→ 1
2
(truncate 7 5)
→ 1, 2
(char-name #\a)
→ NIL
OR=> "LOWERCASE-a"
OR=> "Small-A"
OR=> "LA01"
(char-name #\a) → implementation-dependent
(function-lambda-expression
(funcall #'(lambda (x) #'(lambda () x)) nil))
→ NIL, true, NIL
OR=> (LAMBDA () X), true, NIL
\NV NIL, false, NIL
\NV (LAMBDA () X), false, NIL
(gcd x (gcd y z)) \EQ (gcd (gcd x y) z)
(+ 1 (print (+ (sqrt (read)) (sqrt (read)))))
\OUT \IN{9 16 }
\OUT 7
→ 8
(progn (format t "~&Who? ") (read-line))
\OUT Who? \IN{Fred, Mary, and Sally\CRLF}
→ "Fred, Mary, and Sally", false
(print ()) ;avoided
(defun three nil 3) ;avoided
'(nil nil) ;list of two symbols
'(() ()) ;list of empty lists
(defun three () 3) ;Emphasize empty parameter list.
(append '() '()) → () ;Emphasize use of empty lists
(not nil) → T ;Emphasize use as Boolean false
(get 'nil 'color) ;Emphasize use as a symbol
(defun add-some (x)
(defun add-some (x) (+ x 2))
(+ x 1)) → ADD-SOME
(mapcar 'add-some '(1 2 3 4))
→ (2 3 4 5)
OR=> (2 4 5 6)
(defun foo (x) (+ x 1))
(find 'a '(a b . c))
(find 'd '(a b . c))
(find 'd '#1=(a b . #1#))
(let ((a (list 2 1 4 3 7 6 'five)))
(ignore-errors (sort a #'<))
a)
→ (1 2 3 4 6 7 FIVE)
OR=> (2 1 4 3 7 6 FIVE)
OR=> (2)
(prog foo ((a (list 1 2 3 4 5 6 7 8 9 10)))
(sort a #'(lambda (x y) (if (zerop (random 5)) (return-from foo a) (> x y)))))
→ (1 2 3 4 5 6 7 8 9 10)
OR=> (3 4 5 6 2 7 8 9 10 1)
OR=> (1 2 4 3)
(let ((x 1)) ;Binds a special variable X
(declare (special x))
(let ((x 2)) ;Binds a lexical variable X
(+ x ;Reads a lexical variable X
(locally (declare (special x))
x)))) ;Reads a special variable X
→ 3
(defun foo (x) (+ x 3))
(defun bar () (setf (symbol-function 'foo) #'(lambda (x) (+ x 4))))
(foo (progn (bar) 20))
3 → 3
#c(2/3 5/8) → #C(2/3 5/8)
#p"S:[BILL]OTHELLO.TXT" → #P"S:[BILL]OTHELLO.TXT"
#(a b c) → #(A B C)
"fred smith" → "fred smith"
(defun two-funs (x)
(list (function (lambda () x))
(function (lambda (y) (setq x y)))))
(setq funs (two-funs 6))
(funcall (car funs)) → 6
(funcall (cadr funs) 43) → 43
(funcall (car funs)) → 43
(let ((x 5) (funs '()))
(dotimes (j 10)
(push #'(lambda (z)
(if (null z) (setq x 0) (+ x z)))
funs))
funs)
(let ((funs '()))
(dotimes (j 10)
(let ((x 5))
(push (function (lambda (z)
(if (null z) (setq x 0) (+ x z))))
funs)))
funs)
(let ((funs '()))
(dotimes (j 10)
(let ((x 5))
(push (function (lambda (z) (+ x z)))
funs)))
funs)
(let ((funs '()))
(dotimes (j 10)
(push (function (lambda (z) (+ 5 z)))
funs))
funs)
(mapcar (function (lambda (x) (+ x 2))) y)
(defun test (x z)
(let ((z (* x 2)))
(print z))
z)
(defun contorted-example (f g x)
(if (= x 0)
(funcall f)
(block here
(+ 5 (contorted-example g
#'(lambda () (return-from here 4))
(- x 1))))))
(contorted-example nil nil 2)
(block here\ssso ...)
(contorted-example nil #'(lambda () (return-from here\ssso 4)) 1)
(block here\ssst ...)
(contorted-example #'(lambda () (return-from here\ssso 4))
#'(lambda () (return-from here\ssst 4))
0)
(funcall f)
where f → #'(lambda () (return-from here\ssso 4))
(return-from here\ssso 4)
(defun invalid-example ()
(let ((y (block here #'(lambda (z) (return-from here z)))))
(if (numberp y) y (funcall y 5))))
(defun fun1 (x)
(catch 'trap (+ 3 (fun2 x))))
(defun fun2 (y)
(catch 'trap (* 5 (fun3 y))))
(defun fun3 (z)
(throw 'trap z))
(defun fun2 (y)
(catch 'snare (* 5 (fun3 y))))
(format nil "~C" #\A) → "A"
(format nil "~C" #\Space) → " "
(format nil "~:C" #\A) → "A"
(format nil "~:C" #\Space) → "Space"
;; This next example assumes an implementation-defined "Control" attribute.
(format nil "~:C" #\Control-Space)
→ "Control-Space"
OR=> "c-Space"
(format nil "~:@C" #\Control-Partial) → "Control-{\Partial} (Top-F)"
(format nil "~,,' ,4:B" 13) → "1101"
(format nil "~,,' ,4:B" 17) → "1 0001"
(format nil "~19,0,' ,4:B" 3333) → "0000 1101 0000 0101"
(format nil "~3,,,' ,2:R" 17) → "1 22"
(format nil "~,,'|,2:D" #xFFFF) → "6|55|35"
"~%;; ~\lbr\ ~<~%;; ~1:; ~S~>~\hat\ ,~\rbr\ .~%"
"~%;; ~\lbr\ ~<~%;; ~1,50:; ~S~>~\hat\ ,~\rbr \ .~%"
(setq *print-level* nil *print-length* 5)
(format nil
"~@[ print level = ~D~]~@[ print length = ~D~]"
*print-level* *print-length*)
→ " print length = 5"
(format \param{stream} "...~@[\param{str}~]..." ...)
\EQ (format \param{stream} "...~:[~;~:*\param{str}~]..." ...)
(setq foo "Items:~#[ none~; ~S~; ~S and ~S~
~:;~@\{~#[~; and~] ~S~\hat\ ,~\}~].")
(format nil foo) → "Items: none."
(format nil foo 'foo) → "Items: FOO."
(format nil foo 'foo 'bar) → "Items: FOO and BAR."
(format nil foo 'foo 'bar 'baz) → "Items: FOO, BAR, and BAZ."
(format nil foo 'foo 'bar 'baz 'quux) → "Items: FOO, BAR, BAZ, and QUUX."
(format nil "The winners are:~\{ ~S~\}."
'(fred harry jill))
→ "The winners are: FRED HARRY JILL."
(format nil "Pairs:~\{ <~S,~S>~\}."
'(a 1 b 2 c 3))
→ "Pairs: <A,1> <B,2> <C,3>."
(format nil "Pairs:~:\lbr <~S,~S>~\rbr\ ."
'((a 1) (b 2) (c 3)))
→ "Pairs: <A,1> <B,2> <C,3>."
(format nil "Pairs:~@\lbr <~S,~S>~\rbr\ ." 'a 1 'b 2 'c 3)
→ "Pairs: <A,1> <B,2> <C,3>."
(format nil "Pairs:~:@\lbr <~S,~S>~\rbr\ ."
'(a 1) '(b 2) '(c 3))
→ "Pairs: <A,1> <B,2> <C,3>."
(apply #'format stream string arguments)
\EQ (format stream "~1\{~:\}" string arguments)
(format nil "~? ~D" "<~A ~D>" '("Foo" 5) 7) → "<Foo 5> 7"
(format nil "~? ~D" "<~A ~D>" '("Foo" 5 14) 7) → "<Foo 5> 7"
(format nil "~@? ~D" "<~A ~D>" "Foo" 5 7) → "<Foo 5> 7"
(format nil "~@? ~D" "<~A ~D>" "Foo" 5 14 7) → "<Foo 5> 14"
(format nil "~@R ~(~@R~)" 14 14)
→ "XIV xiv"
(defun f (n) (format nil "~@(~R~) error~:P detected." n)) → F
(f 0) → "Zero errors detected."
(f 1) → "One error detected."
(f 23) → "Twenty-three errors detected."
(format nil "~@(how is ~:(BOB SMITH~)?~)")
→ "How is bob smith?"
\NV "How is Bob Smith?"
(format nil "~D tr~:@P/~D win~:P" 7 1) → "7 tries/1 win"
(format nil "~D tr~:@P/~D win~:P" 1 0) → "1 try/0 wins"
(format nil "~D tr~:@P/~D win~:P" 1 3) → "1 try/3 wins"
(setq donestr "Done.~{\hat} ~D warning~:P.~{\hat} ~D error~:P.")
→ "Done.~{\hat} ~D warning~:P.~{\hat} ~D error~:P."
(format nil donestr) → "Done."
(format nil donestr 3) → "Done. 3 warnings."
(format nil donestr 1 5) → "Done. 1 warning. 5 errors."
(format nil "~:\lbr\ ~@?~:\hat\ ...~\rbr\ " '(("a") ("b"))) → "a...b"
(setq tellstr "~@(~@[~R~]~{\hat} ~A!~)")
→ "~@(~@[~R~]~{\hat} ~A!~)"
(format nil tellstr 23) → "Twenty-three!"
(format nil tellstr nil "losers") → " Losers!"
(format nil tellstr 23 "losers") → "Twenty-three losers!"
(format nil "~15<~S~;~{\hat}~S~;~{\hat}~S~>" 'foo)
→ " FOO"
(format nil "~15<~S~;~{\hat}~S~;~{\hat}~S~>" 'foo 'bar)
→ "FOO BAR"
(format nil "~15<~S~;~{\hat}~S~;~{\hat}~S~>" 'foo 'bar 'baz)
→ "FOO BAR BAZ"
(defun type-clash-error (fn nargs argnum right-type wrong-type)
(format *error-output*
"~&~S requires its ~:[~:R~;~*~]~
argument to be of type ~S,~%but it was called ~
with an argument of type ~S.~%"
fn (eql nargs 1) argnum right-type wrong-type))
(type-clash-error 'aref nil 2 'integer 'vector) prints:
AREF requires its second argument to be of type INTEGER,
but it was called with an argument of type VECTOR.
NIL
(type-clash-error 'car 1 1 'list 'short-float) prints:
CAR requires its argument to be of type LIST,
but it was called with an argument of type SHORT-FLOAT.
NIL
(format nil "~:[abc~:@(def~;ghi~
:@(jkl~]mno~)" x) ;Invalid!
(format nil "~@?ghi~)" "abc~@(def") ;Invalid!
(format nil "foo") → "foo"
(setq x 5) → 5
(format nil "The answer is ~D." x) → "The answer is 5."
(format nil "The answer is ~3D." x) → "The answer is 5."
(format nil "The answer is ~3,'0D." x) → "The answer is 005."
(format nil "The answer is ~:D." (expt 47 x))
→ "The answer is 229,345,007."
(setq y "elephant") → "elephant"
(format nil "Look at the ~A!" y) → "Look at the elephant!"
(setq n 3) → 3
(format nil "~D item~:P found." n) → "3 items found."
(format nil "~R dog~:[s are~; is~] here." n (= n 1))
→ "three dogs are here."
(format nil "~R dog~:*~[s are~; is~:;s are~] here." n)
→ "three dogs are here."
(format nil "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n)
→ "Here are three puppies."
(defun foo (x)
(format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F"
x x x x x x)) → FOO
(foo 3.14159) → " 3.14| 31.42| 3.14|3.1416|3.14|3.14159"
(foo -3.14159) → " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159"
(foo 100.0) → "100.00|******|100.00| 100.0|100.00|100.0"
(foo 1234.0) → "1234.00|******|??????|1234.0|1234.00|1234.0"
(foo 0.006) → " 0.01| 0.06| 0.01| 0.006|0.01|0.006"
(defun foo (x)
(format nil
"~9,2,1,,'*E|~10,3,2,2,'?,,'\$E|~
~9,3,2,-2,'%@E|~9,2E"
x x x x))
(foo 3.14159) → " 3.14E+0| 31.42\$-01|+.003E+03| 3.14E+0"
(foo -3.14159) → " -3.14E+0|-31.42\$-01|-.003E+03| -3.14E+0"
(foo 1100.0) → " 1.10E+3| 11.00\$+02|+.001E+06| 1.10E+3"
(foo 1100.0L0) → " 1.10L+3| 11.00\$+02|+.001L+06| 1.10L+3"
(foo 1.1E13) → "*********| 11.00\$+12|+.001E+16| 1.10E+13"
(foo 1.1L120) → "*********|??????????|%%%%%%%%%|1.10L+120"
(foo 1.1L1200) → "*********|??????????|%%%%%%%%%|1.10L+1200"
(dotimes (k 13)
(format t "~%Scale factor ~2D: |~13,6,2,VE|"
(- k 5) (- k 5) 3.14159))
Scale factor -5: | 0.000003E+06|
Scale factor -4: | 0.000031E+05|
Scale factor -3: | 0.000314E+04|
Scale factor -2: | 0.003142E+03|
Scale factor -1: | 0.031416E+02|
Scale factor 0: | 0.314159E+01|
Scale factor 1: | 3.141590E+00|
Scale factor 2: | 31.41590E-01|
Scale factor 3: | 314.1590E-02|
Scale factor 4: | 3141.590E-03|
Scale factor 5: | 31415.90E-04|
Scale factor 6: | 314159.0E-05|
Scale factor 7: | 3141590.E-06|
(defun foo (x)
(format nil "~9,2,1,,'*G|~9,3,2,3,'?,,'\$G|~9,3,2,0,'%G|~9,2G"
x x x x))
(foo 0.0314159) → " 3.14E-2|314.2\$-04|0.314E-01| 3.14E-2"
(foo 0.314159) → " 0.31 |0.314 |0.314 | 0.31 "
(foo 3.14159) → " 3.1 | 3.14 | 3.14 | 3.1 "
(foo 31.4159) → " 31. | 31.4 | 31.4 | 31. "
(foo 314.159) → " 3.14E+2| 314. | 314. | 3.14E+2"
(foo 3141.59) → " 3.14E+3|314.2\$+01|0.314E+04| 3.14E+3"
(foo 3141.59L0) → " 3.14L+3|314.2\$+01|0.314L+04| 3.14L+3"
(foo 3.14E12) → "*********|314.0\$+10|0.314E+13| 3.14E+12"
(foo 3.14L120) → "*********|?????????|%%%%%%%%%|3.14L+120"
(foo 3.14L1200) → "*********|?????????|%%%%%%%%%|3.14L+1200"
(format nil "~10<foo~;bar~>") → "foo bar"
(format nil "~10:<foo~;bar~>") → " foo bar"
(format nil "~10<foobar~>") → " foobar"
(format nil "~10:<foobar~>") → " foobar"
(format nil "~10:@<foo~;bar~>") → " foo bar "
(format nil "~10@<foobar~>") → "foobar "
(format nil "~10:@<foobar~>") → " foobar "
(FORMAT NIL "Written to ~A." #P"foo.bin")
→ "Written to foo.bin."
(defmethod width ((c character-class) &key font) ...)
(defmethod width ((p picture-class) &key pixel-size) ...)
(width (make-instance `character-class :char #\Q)
:font 'baskerville :pixel-size 10)
(width (make-instance `picture-class :glyph (glyph #\Q))
:font 'baskerville :pixel-size 10)
(width (make-instance `character-picture-class :char #\Q)
:font 'baskerville :pixel-size 10)
(setq a (make-hash-table)) → #<HASH-TABLE EQL 0/120 32536573>
(setf (gethash 'color a) 'brown) → BROWN
(setf (gethash 'name a) 'fred) → FRED
(gethash 'color a) → BROWN, true
(gethash 'name a) → FRED, true
(gethash 'pointy a) → NIL, false
(loop for i from 1 to (compute-top-value) ; first clause
while (not (unacceptable i)) ; second clause
collect (square i) ; third clause
do (format t "Working on ~D now" i) ; fourth clause
when (evenp i) ; fifth clause
do (format t "~D is a non-odd number" i)
finally (format t "About to exit!")) ; sixth clause
;;; This expression uses the old syntax for type specifiers.
(loop for i fixnum upfrom 3 ...)
;;; This expression uses the new syntax for type specifiers.
(loop for i of-type fixnum upfrom 3 ...)
;; Declare X and Y to be of type VECTOR and FIXNUM respectively.
(loop for (x y) of-type (vector fixnum)
in l do ...)
;; Collect values by using FOR constructs.
(loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
for a of-type integer = (first numlist)
and b of-type integer = (second numlist)
and c of-type float = (third numlist)
collect (list c b a))
→ ((4.0 2 1) (8.3 6 5) (10.4 9 8))
;; Destructuring simplifies the process.
(loop for (a b c) of-type (integer integer float) in
'((1 2 4.0) (5 6 8.3) (8 9 10.4))
collect (list c b a))
→ ((4.0 2 1) (8.3 6 5) (10.4 9 8))
;; If all the types are the same, this way is even simpler.
(loop for (a b c) of-type float in
'((1.0 2.0 4.0) (5.0 6.0 8.3) (8.0 9.0 10.4))
collect (list c b a))
→ ((4.0 2.0 1.0) (8.3 6.0 5.0) (10.4 9.0 8.0))
;; Initialize and declare variables in parallel by using the AND construct.\kern-7pt
(loop with (a b) of-type float = '(1.0 2.0)
and (c d) of-type integer = '(3 4)
and (e f)
return (list a b c d e f))
→ (1.0 2.0 3 4 NIL NIL)
(loop for (a nil b) = '(1 2 3)
do (return (list a b)))
→ (1 3)
(loop for (x . y) = '(1 . 2)
do (return y))
→ 2
(loop for ((a . b) (c . d)) of-type ((float . float) (integer . integer)) in
'(((1.2 . 2.4) (3 . 4)) ((3.4 . 4.6) (5 . 6)))
collect (list a b c d))
→ ((1.2 2.4 3 4) (3.4 4.6 5 6))
(let ((x 1)) (loop for i from x by (incf x) to 10 collect i))
→ (1 3 5 7 9)
(let ((x 1)) (loop for i by (incf x) from x to 10 collect i))
→ (2 4 6 8 10)
;; Print some numbers.
(loop for i from 1 to 3
do (print i))
\OUT 1
\OUT 2
\OUT 3
→ NIL
;; Print every third number.
(loop for i from 10 downto 1 by 3
do (print i))
\OUT 10
\OUT 7
\OUT 4
\OUT 1
→ NIL
;; Step incrementally from the default starting value.
(loop for i below 3
do (print i))
\OUT 0
\OUT 1
\OUT 2
→ NIL
;; Print every item in a list.
(loop for item in '(1 2 3) do (print item))
\OUT 1
\OUT 2
\OUT 3
→ NIL
;; Print every other item in a list.
(loop for item in '(1 2 3 4 5) by #'cddr
do (print item))
\OUT 1
\OUT 3
\OUT 5
→ NIL
;; Destructure a list, and sum the x values using fixnum arithmetic.
(loop for (item . x) of-type (t . fixnum) in '((A . 1) (B . 2) (C . 3))
unless (eq item 'B) sum x)
→ 4
;; Collect successive tails of a list.
(loop for sublist on '(a b c d)
collect sublist)
→ ((A B C D) (B C D) (C D) (D))
;; Print a list by using destructuring with the loop keyword ON.
(loop for (item) on '(1 2 3)
do (print item))
\OUT 1
\OUT 2
\OUT 3
→ NIL
%;; The original code:
% (prog (...)
% (setq x (some-value))
% tag (print x)
% (setq x (some-value))
% (go tag))
%
%;; The expanded code:
% (prog (...)
% tag (setq x (some-value))
% (print x)
% (go tag))
%
;; Collect some numbers.
(loop for item = 1 then (+ item 10)
for iteration from 1 to 5
collect item)
→ (1 11 21 31 41)
(loop for char across (the simple-string (find-message channel))
do (write-char char stream))
% being \lbracket\ each|the\rbracket \lbracket\ hash-value|hash-values|hash-key|hash-key\rbracket \lbracket\ in|of\rbracket
%
% being \lbracket\ each|the\rbracket \lbracket\ \lbracket\ \lbracket\
% present|external\rbracket\ symbol\rbracket | \lbracket\
% \lbracket\ present|external\rbracket symbols\rbracket\rbracket \lbracket\ in|of\rbracket
%
(let ((*package* (make-package "TEST-PACKAGE-1")))
;; For effect, intern some symbols
(read-from-string "(THIS IS A TEST)")
(export (intern "THIS"))
(loop for x being each present-symbol of *package*
do (print x)))
\OUT A
\OUT TEST
\OUT THIS
\OUT IS
→ NIL
(loop with a = 1
with b = (+ a 2)
with c = (+ b 3)
return (list a b c))
→ (1 3 6)
(block nil
(let* ((a 1)
(b (+ a 2))
(c (+ b 3)))
(tagbody
(next-loop (return (list a b c))
(go next-loop)
end-loop))))
(loop with a = 1
and b = 2
and c = 3
return (list a b c))
→ (1 2 3)
(block nil
(let ((a 1)
(b 2)
(c 3))
(tagbody
(next-loop (return (list a b c))
(go next-loop)
end-loop))))
;; These bindings occur in sequence.
(loop with a = 1
with b = (+ a 2)
with c = (+ b 3)
return (list a b c))
→ (1 3 6)
;; These bindings occur in parallel.
(setq a 5 b 10)
→ 10
(loop with a = 1
and b = (+ a 2)
and c = (+ b 3)
return (list a b c))
→ (1 7 13)
;; This example shows a shorthand way to declare local variables
;; that are of different types.
(loop with (a b c) of-type (float integer float)
return (format nil "~A ~A ~A" a b c))
→ "0.0 0 0.0"
;; This example shows a shorthand way to declare local variables
;; that are the same type.
(loop with (a b c) of-type float
return (format nil "~A ~A ~A" a b c))
→ "0.0 0.0 0.0"
;; Collect every name and the kids in one list by using
;; COLLECT and APPEND.
(loop for name in '(fred sue alice joe june)
for kids in '((bob ken) () () (kris sunshine) ())
collect name
append kids)
→ (FRED BOB KEN SUE ALICE JOE KRIS SUNSHINE JUNE)
%;; Count and collect names and ages.
% (loop for name in '(fred sue alice joe june)
% as age in '(22 26 19 20 10)
% append (list name age) into name-and-age-list
% count name into name-count
% sum age into total-age
% finally
% (return
% (values (round total-age name-count)
% name-and-age-list)))
%→ 19, (FRED 22 SUE 26 ALICE 19 JOE 20 JUNE 10)
%
;; Collect all the symbols in a list.
(loop for i in '(bird 3 4 turtle (1 . 4) horse cat)
when (symbolp i) collect i)
→ (BIRD TURTLE HORSE CAT)
;; Collect and return odd numbers.
(loop for i from 1 to 10
if (oddp i) collect i)
→ (1 3 5 7 9)
;; Collect items into local variable, but don't return them.
(loop for i in '(a b c d) by #'cddr
collect i into my-list
finally (print my-list))
\OUT (A C)
→ NIL
;; Use APPEND to concatenate some sublists.
(loop for x in '((a) (b) ((c)))
append x)
→ (A B (C))
;; NCONC some sublists together. Note that only lists made by the
;; call to LIST are modified.
(loop for i upfrom 0
as x in '(a b (c))
nconc (if (evenp i) (list x) nil))
→ (A (C))
(loop for i in '(a b nil c nil d e)
count i)
→ 5
(loop for i in '(2 1 5 3 4)
maximize i)
→ 5
(loop for i in '(2 1 5 3 4)
minimize i)
→ 1
;; In this example, FIXNUM applies to the internal variable that holds
;; the maximum value.
(setq series '(1.2 4.3 5.7))
→ (1.2 4.3 5.7)
(loop for v in series
maximize (round v) of-type fixnum)
→ 6
;; In this example, FIXNUM applies to the variable RESULT.
(loop for v of-type float in series
minimize (round v) into result of-type fixnum
finally (return result))
→ 1
(loop for i of-type fixnum in '(1 2 3 4 5)
sum i)
→ 15
(setq series '(1.2 4.3 5.7))
→ (1.2 4.3 5.7)
(loop for v in series
sum (* 2.0 v))
→ 22.4
(loop repeat 3
do (format t "~&What I say three times is true.~%"))
\OUT What I say three times is true.
\OUT What I say three times is true.
\OUT What I say three times is true.
→ NIL
(loop repeat -15
do (format t "What you see is what you expect~%"))
→ NIL
;; Make sure I is always less than 11 (two ways).
;; The FOR construct terminates these loops.
(loop for i from 0 to 10
always (< i 11))
→ T
(loop for i from 0 to 10
never (> i 11))
→ T
;; If I exceeds 10 return I; otherwise, return NIL.
;; The THEREIS construct terminates this loop.
(loop for i from 0
thereis (when (> i 10) i) )
→ 11
;;; The FINALLY clause is not evaluated in these examples.
(loop for i from 0 to 10
always (< i 9)
finally (print "you won't see this"))
→ NIL
(loop never t
finally (print "you won't see this"))
→ NIL
(loop thereis "Here is my value"
finally (print "you won't see this"))
→ "Here is my value"
;; The FOR construct terminates this loop, so the FINALLY clause
;; is evaluated.
(loop for i from 1 to 10
thereis (> i 11)
finally (prin1 'got-here))
\OUT GOT-HERE
→ NIL
;; If this code could be used to find a counterexample to Fermat's
;; last theorem, it would still not return the value of the
;; counterexample because all of the THEREIS clauses in this example
;; only return T. But if Fermat is right, that won't matter
;; because this won't terminate.
(loop for z upfrom 2
thereis
(loop for n upfrom 3 below (log z 2)
thereis
(loop for x below z
thereis
(loop for y below z
thereis (= (+ (expt x n) (expt y n))
(expt z n))))))
(loop while (hungry-p) do (eat))
;; UNTIL NOT is equivalent to WHILE.
(loop until (not (hungry-p)) do (eat))
;; Collect the length and the items of STACK.
(let ((stack '(a b c d e f)))
(loop for item = (length stack) then (pop stack)
collect item
while stack))
→ (6 A B C D E F)
;; Use WHILE to terminate a loop that otherwise wouldn't terminate.
;; Note that WHILE occurs after the WHEN.
(loop for i fixnum from 3
when (oddp i) collect i
while (< i 5))
→ (3 5)
;; Print numbers and their squares.
;; The DO construct applies to multiple forms.
(loop for i from 1 to 3
do (print i)
(print (* i i)))
\OUT 1
\OUT 1
\OUT 2
\OUT 4
\OUT 3
\OUT 9
→ NIL
;; Signal an exceptional condition.
(loop for item in '(1 2 3 a 4 5)
when (not (numberp item))
return (cerror "enter new value" "non-numeric value: ~s" item))
Error: non-numeric value: A
;; The previous example is equivalent to the following one.
(loop for item in '(1 2 3 a 4 5)
when (not (numberp item))
do (return
(cerror "Enter new value" "non-numeric value: ~s" item)))
Error: non-numeric value: A
;; This example parses a simple printed string representation from
;; BUFFER (which is itself a string) and returns the index of the
;; closing double-quote character.
(let ((buffer "\"a\" \"b\""))
(loop initially (unless (char= (char buffer 0) #\")
(loop-finish))
for i of-type fixnum from 1 below (length (the string buffer))
when (char= (char buffer i) #\")
return i))
→ 2
;; The collected value is returned.
(loop for i from 1 to 10
when (> i 5)
collect i
finally (prin1 'got-here))
\OUT GOT-HERE
→ (6 7 8 9 10)
;; Return both the count of collected numbers and the numbers.
(loop for i from 1 to 10
when (> i 5)
collect i into number-list
and count i into number-count
finally (return (values number-count number-list)))
→ 5, (6 7 8 9 10)
;; Just name and return.
(loop named max
for i from 1 to 10
do (print i)
do (return-from max 'done))
\OUT 1
→ DONE
(let ((i 0)) ; no loop keywords are used
(loop (incf i) (if (= i 3) (return i)))) → 3
(let ((i 0)(j 0))
(tagbody
(loop (incf j 3) (incf i) (if (= i 3) (go exit)))
exit)
j) → 9
(loop for x from 1 to 10
for y = nil then x
collect (list x y))
→ ((1 NIL) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9) (10 10))
(loop for x from 1 to 10
and y = nil then x
collect (list x y))
→ ((1 NIL) (2 1) (3 2) (4 3) (5 4) (6 5) (7 6) (8 7) (9 8) (10 9))
;; Group conditional clauses.
(loop for i in '(1 324 2345 323 2 4 235 252)
when (oddp i)
do (print i)
and collect i into odd-numbers
and do (terpri)
else ; I is even.
collect i into even-numbers
finally
(return (values odd-numbers even-numbers)))
\OUT 1
\OUT
\OUT 2345
\OUT
\OUT 323
\OUT
\OUT 235
→ (1 2345 323 235), (324 2 4 252)
;; Collect numbers larger than 3.
(loop for i in '(1 2 3 4 5 6)
when (and (> i 3) i)
collect it) ; IT refers to (and (> i 3) i).
→ (4 5 6)
;; Find a number in a list.
(loop for i in '(1 2 3 4 5 6)
when (and (> i 3) i)
return it)
→ 4
;; The above example is similar to the following one.
(loop for i in '(1 2 3 4 5 6)
thereis (and (> i 3) i))
→ 4
\medbreak
;; Nest conditional clauses.
(let ((list '(0 3.0 apple 4 5 9.8 orange banana)))
(loop for i in list
when (numberp i)
when (floatp i)
collect i into float-numbers
else ; Not (floatp i)
collect i into other-numbers
else ; Not (numberp i)
when (symbolp i)
collect i into symbol-list
else ; Not (symbolp i)
do (error "found a funny value in list ~S, value ~S~%" list i)
finally (return (values float-numbers other-numbers symbol-list))))
→ (3.0 9.8), (0 4 5), (APPLE ORANGE BANANA)
;; Without the END preposition, the last AND would apply to the
;; inner IF rather than the outer one.
(loop for x from 0 to 3
do (print x)
if (zerop (mod x 2))
do (princ " a")
and if (zerop (floor x 2))
do (princ " b")
end
and do (princ " c"))
\OUT 0 a b c
\OUT 1
\OUT 2 a c
\OUT 3
→ NIL
(loop for \i{internal-variable} downfrom (- \i{n} 1) to 0 ...)
(a b c)
% (defun traffic-light (color)
% (case color
% (green)
% (red (stop))
% (amber (accelerate)) ;Insert more colors after this line.
% ))
%
(a b c . d)
(cons 'a (cons 'b (cons 'c 'd)))
(cons 'this-one 'that-one) → (this-one . that-one)
(a b c d . (e f . (g))) \EQ (a b c d e f g)
'foo → FOO
''foo → (QUOTE FOO)
(car ''foo) → QUOTE
(+ 3 ; three
4)
→ 7
;;;; Math Utilities
;;; FIB computes the the Fibonacci function in the traditional
;;; recursive way.
(defun fib (n)
(check-type n integer)
;; At this point we're sure we have an integer argument.
;; Now we can get down to some serious computation.
(cond ((< n 0)
;; Hey, this is just supposed to be a simple example.
;; Did you really expect me to handle the general case?
(error "FIB got ~D as an argument." n))
((< n 2) n) ;fib[0]=0 and fib[1]=1
;; The cheap cases didn't work.
;; Nothing more to do but recurse.
(t (+ (fib (- n 1)) ;The traditional formula
(fib (- n 2)))))) ; is fib[n-1]+fib[n-2].
`(cond ((numberp ,x) ,@y) (t (print ,x) ,@y))
(list 'cond
(cons (list 'numberp x) y)
(list* 't (list 'print x) y))
`(x ,x ,@x foo ,(cadr x) bar ,(cdr x) baz ,@(cdr x))
→ (x (a b c) a b c foo b bar (b c) baz b c)
(append \lbracket\ x1\rbracket \lbracket\ x2\rbracket \lbracket\ x3\rbracket ... \lbracket\ xn\rbracket (quote atom))
(append \lbracket\ x1\rbracket \lbracket\ x2\rbracket \lbracket\ x3\rbracket ... \lbracket\ xn\rbracket form)
`((,a b) ,c ,@d)
(append (list (append (list a) (list 'b) '\nil)) (list c) d '\nil)
(append (list (append (list a) (list 'b))) (list c) d)
(append (list (append (list a) '(b))) (list c) d)
(list* (cons a '(b)) c d)
(list* (cons a (list 'b)) c d)
(append (list (cons a '(b))) (list c) d)
(list* (cons a '(b)) c (copy-list d))
(apply #'+ l) \EQ (apply (function +) l)
#(a b c c c c)
#6(a b c c c c)
#6(a b c)
#6(a b c c)
#(a b c) ;A vector of length 3
#(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47)
;A vector containing the primes below 50
#() ;An empty vector
#*101111
#6*101111
#6*101
#6*1011
#* ;An empty bit-vector
#B1101 \EQ 13 ;1101\ssst
#b101/11 \EQ 5/3
#o37/15 \EQ 31/13
#o777 \EQ 511
#o105 \EQ 69 ;105\ssse
#xF00 \EQ 3840
#x105 \EQ 261 ;105\ssss
0 1 5
foo 2 (hot dog)
(0 1 5) (foo 2 (hot dog))
((0 1 5) (foo 2 (hot dog)))
#.(cm keyword1 'value1 keyword2 'value2 ...)
(intern (string slotj) (find-package 'keyword))
(setq x (list 'p 'q))
(setq y (list (list 'a 'b) x 'foo x))
(rplacd (last y) (cdr y))
((a b) . #1=(#2=(p q) foo #2# . #1#))
((a b) (p q) foo (p q) (p q) foo (p q) (p q) foo (p q) ...)
#-\param{test} \param{expression} \EQ #+(not \param{test}) \param{expression}
;;; In this example, some debugging code is commented out with #|...|#
;;; Note that this kind of comment can occur in the middle of a line
;;; (because a delimiter marks where the end of the comment occurs)
;;; where a semicolon comment can only occur at the end of a line
;;; (because it comments out the rest of the line).
(defun add3 (n) #|(format t "~&Adding 3 to ~D." n)|# (+ n 3))
\goodbreak
;;; The examples that follow show issues related to #| ... |# nesting.
;;; In this first example, #| and |# always occur properly paired,
;;; so nesting works naturally.
(defun mention-fun-fact-1a ()
(format t "CL uses ; and #|...|# in comments."))
→ MENTION-FUN-FACT-1A
(mention-fun-fact-1a)
\OUT CL uses ; and #|...|# in comments.
→ NIL
#| (defun mention-fun-fact-1b ()
(format t "CL uses ; and #|...|# in comments.")) |#
(fboundp 'mention-fun-fact-1b) → NIL
\goodbreak
;;; In this example, vertical-bar followed by sharpsign needed to appear
;;; in a string without any matching sharpsign followed by vertical-bar
;;; having preceded this. To compensate, the programmer has included a
;;; slash separating the two characters. In case 2a, the slash is
;;; unnecessary but harmless, but in case 2b, the slash is critical to
;;; allowing the outer #| ... |# pair match. If the slash were not present,
;;; the outer comment would terminate prematurely.
(defun mention-fun-fact-2a ()
(format t "Don't use |\# unmatched or you'll get in trouble!"))
→ MENTION-FUN-FACT-2A
(mention-fun-fact-2a)
\OUT Don't use |# unmatched or you'll get in trouble!
→ NIL
#| (defun mention-fun-fact-2b ()
(format t "Don't use |\# unmatched or you'll get in trouble!") |#
(fboundp 'mention-fun-fact-2b) → NIL
\goodbreak
;;; In this example, the programmer attacks the mismatch problem in a
;;; different way. The sharpsign vertical bar in the comment is not needed
;;; for the correct parsing of the program normally (as in case 3a), but
;;; becomes important to avoid premature termination of a comment when such
;;; a program is commented out (as in case 3b).
(defun mention-fun-fact-3a () ; #|
(format t "Don't use |# unmatched or you'll get in trouble!"))
→ MENTION-FUN-FACT-3A
(mention-fun-fact-3a)
\OUT Don't use |# unmatched or you'll get in trouble!
→ NIL
#|
(defun mention-fun-fact-3b () ; #|
(format t "Don't use |# unmatched or you'll get in trouble!"))
|#
(fboundp 'mention-fun-fact-3b) → NIL
#|| (+ #|| 3 ||# 4 5) ||#
#| (+ #| 3 |# 4 5) |#
(+ 1/3 2/3 1.0d0 1.0 1.0e-15)
(+ (+ 1/3 2/3) (+ 1.0d0 1.0e-15) 1.0)
;;;; Combining rationals with floats.
;;; This example assumes an implementation in which
;;; (float-radix 0.5) is 2 (as in IEEE) or 16 (as in IBM/360),
;;; or else some other implementation in which 1/2 has an exact
;;; representation in floating point.
(+ 1/2 0.5) → 1.0
(- 1/2 0.5d0) → 0.0d0
(+ 0.5 -0.5 1/2) → 0.5
;;;; Comparing rationals with floats.
;;; This example assumes an implementation in which the default float
;;; format is IEEE single-float, IEEE double-float, or some other format
;;; in which 5/7 is rounded upwards by FLOAT.
(< 5/7 (float 5/7)) → T
(< 5/7 (rational (float 5/7))) → T
(< (float 5/7) (float 5/7)) → NIL
#c(1.0 1.0) → #C(1.0 1.0)
#c(0.0 0.0) → #C(0.0 0.0)
#c(1.0 1) → #C(1.0 1.0)
#c(0.0 0) → #C(0.0 0.0)
#c(1 1) → #C(1 1)
#c(0 0) → 0
(typep #c(1 1) '(complex (eql 1))) → T
(typep #c(0 0) '(complex (eql 0))) → NIL
(defclass q () ((x :initarg a)))
(defclass r (q) ((x :initarg b))
(:default-initargs a 1 b 2))
(defmethod make-instance ((class standard-class) &rest initargs)
...
(let ((instance (apply #'allocate-instance class initargs)))
(apply #'initialize-instance instance initargs)
instance))
(defmethod make-instance ((class-name symbol) &rest initargs)
(apply #'make-instance (find-class class-name) initargs))
(defmethod initialize-instance ((instance standard-object) &rest initargs)
(apply #'shared-initialize instance t initargs)))
;; In a TOPS-20 implementation, which uses {\hat}V to quote
(NAMESTRING (MAKE-PATHNAME :HOST "OZ" :NAME "<TEST>"))
→ #P"OZ:PS:{\hat}V<TEST{\hat}V>"
\NV #P"OZ:PS:<TEST>"
(pathname-type
(merge-pathnames (make-pathname :type "LISP")
(make-pathname :type "TEXT")))
→ "LISP"
\smallbreak
(pathname-type
(merge-pathnames (make-pathname :type nil)
(make-pathname :type "LISP")))
→ "LISP"
\smallbreak
(pathname-type
(merge-pathnames (make-pathname :type :unspecific)
(make-pathname :type "LISP")))
→ :UNSPECIFIC
(defmacro wrong-order (x y) `(getf ,y ,x))
(push value (wrong-order place1 place2))
(setf place1 value1 place2 value2 ...)
(let ((ref2 (list '())))
(push (progn (princ "1") 'ref-1)
(car (progn (princ "2") ref2))))
\OUT 12
→ (REF1)
(let (x)
(push (setq x (list 'a))
(car (setq x (list 'b))))
x)
→ (((A) . B))
(setq integer #x69) → #x69
(rotatef (ldb (byte 4 4) integer)
(ldb (byte 4 0) integer))
integer → #x96
;;; This example is trying to swap two independent bit fields
;;; in an integer. Note that the generalized variable of
;;; interest here is just the (possibly local) program variable
;;; integer.
(setq s (setq r (list (list 'a 1 'b 2 'c 3)))) → ((a 1 b 2 c 3))
(setf (getf (car r) 'b)
(progn (setq r nil) 6)) → 6
r → NIL
s → ((A 1 B 6 C 3))
;;; Note that the (setq r nil) does not affect the actions of
;;; the SETF because the value of R had already been saved in
;;; a temporary variable as part of the step 1. Only the CAR
;;; of this value will be retrieved, and subsequently modified
;;; after the value computation.
(setf (the integer (cadr x)) (+ y 3))
(setf (cadr x) (the integer (+ y 3)))
(setf (apply \#'\param{name} \starparam{arg}) \param{val})
\EQ (apply \#'(setf \param{name}) \param{val} \starparam{arg})
(let ((#:temp-1 arg1) ;force correct order of evaluation
(#:temp-2 arg2)
...
(#:temp-0 \param{new-value}))
(funcall (function (setf \param{f})) #:temp-0 #:temp-1 #:temp-2...))
(operator \starparam{preceding-form} \param{place} \starparam{following-form})
<-1---<--<--2---3->--4-->->
000000000000000000000000000
11 111111111111111111111111
22 222
333 3333
44444444444444 44444
(defun simple-pprint-defun (*standard-output* list)
(pprint-logical-block (*standard-output* list :prefix "(" :suffix ")")
(write (first list))
(write-char #\Space)
(pprint-newline :miser)
(pprint-indent :current 0)
(write (second list))
(write-char #\Space)
(pprint-newline :fill)
(write (third list))
(pprint-indent :block 1)
(write-char #\Space)
(pprint-newline :linear)
(write (fourth list))))
(simple-pprint-defun *standard-output* '(defun prod (x y) (* x y)))
(DEFUN PROD (X Y)
(* X Y))
(DEFUN PROD
(X Y)
(* X Y))
(DEFUN
PROD
(X Y)
(* X Y))
(pprint-logical-block (*standard-output* nil :per-line-prefix ";;; ")
(simple-pprint-defun *standard-output* '(defun prod (x y) (* x y))))
;;; (DEFUN PROD
;;; (X Y)
;;; (* X Y))
(defun pprint-let (*standard-output* list)
(pprint-logical-block (nil list :prefix "(" :suffix ")")
(write (pprint-pop))
(pprint-exit-if-list-exhausted)
(write-char #\Space)
(pprint-logical-block (nil (pprint-pop) :prefix "(" :suffix ")")
(pprint-exit-if-list-exhausted)
(loop (pprint-logical-block (nil (pprint-pop) :prefix "(" :suffix ")")
(pprint-exit-if-list-exhausted)
(loop (write (pprint-pop))
(pprint-exit-if-list-exhausted)
(write-char #\Space)
(pprint-newline :linear)))
(pprint-exit-if-list-exhausted)
(write-char #\Space)
(pprint-newline :fill)))
(pprint-indent :block 1)
(loop (pprint-exit-if-list-exhausted)
(write-char #\Space)
(pprint-newline :linear)
(write (pprint-pop)))))
(pprint-let *standard-output*
'#1=(let (x (*print-length* (f (g 3)))
(z . 2) (k (car y)))
(setq x (sqrt z)) #1#))
#1=(LET (X (*PRINT-LENGTH* (F #)) (Z . 2) (K (CAR Y)))
(SETQ X (SQRT Z))
#1#)
#1=(LET (X (*PRINT-PRETTY* (F #))
(Z . 2) (K (CAR Y)))
(SETQ X (SQRT Z))
#1#)
(LET (X
(*PRINT-LENGTH*
(F #))
(Z . 2) ...)
(SETQ X (SQRT Z))
...)
(defun pprint-vector (*standard-output* v)
(pprint-logical-block (nil nil :prefix "#(" :suffix ")")
(let ((end (length v)) (i 0))
(when (plusp end)
(loop (pprint-pop)
(write (aref v i))
(if (= (incf i) end) (return nil))
(write-char #\Space)
(pprint-newline :fill))))))
(pprint-vector *standard-output* '#(12 34 567 8 9012 34 567 89 0 1 23))
#(12 34 567 8
9012 34 567
89 0 1 23)
(defun simple-pprint-defun (*standard-output* list)
(format T "~:<~W ~@_~:I~W ~:_~W~1I ~_~W~:>" list))
(defun pprint-let (*standard-output* list)
(format T "~:<~W~{\hat}~:<~@\{~:<~@\{~W~{\hat}~_~\}~:>~{\hat}~:_~\}~:>~1I~@\{~{\hat}~_~W~\}~:>" list))
(setq *print-pprint-dispatch* (copy-pprint-dispatch nil))
(set-pprint-dispatch 'ratio
#'(lambda (s obj)
(format s "#.(/ ~W ~W)"
(numerator obj) (denominator obj))))
(set-pprint-dispatch '(and ratio (satisfies minusp))
#'(lambda (s obj)
(format s "#.(- (/ ~W ~W))"
(- (numerator obj)) (denominator obj)))
5)
(pprint '(1/3 -2/3))
(#.(/ 1 3) \#.(- (/ 2 3)))
(set-pprint-dispatch '(cons (member quote)) ()
#'(lambda (s list)
(if (and (consp (cdr list)) (null (cddr list)))
(funcall (formatter "'~W") s (cadr list))
(pprint-fill s list))))
(set-pprint-dispatch '(cons (member my-let))
(pprint-dispatch '(let) nil))
(set-pprint-dispatch '(cons (not (and symbol (satisfies fboundp))))
#'pprint-fill -5)
;; Assume a line length of 9
(pprint '(0 b c d e f g h i j k))
(0 b c d
e f g h
i j k)
(defstruct family mom kids)
(set-pprint-dispatch 'family
#'(lambda (s f)
(funcall (formatter "~@<#<~;~W and ~2I~_~/pprint-fill/~;>~:>")
s (family-mom f) (family-kids f))))
(write (list 'principal-family
(make-family :mom "Lucy"
:kids '("Mark" "Bob" . "Dan")))
:right-margin 25 :pretty T :escape nil :miser-width nil)
(PRINCIPAL-FAMILY
#<Lucy and
Mark Bob . Dan>)
27 27. #o33 #x1B #b11011 #.(* 3 3 3) 81/3
(A B) (a b) ( a b ) (\A |B|)
(|\A|
B
)
(let ((x (make-symbol "FOO"))) (list x x))
(defun test-readtable-case-printing ()
(let ((*readtable* (copy-readtable nil))
(*print-case* *print-case*))
(format t "READTABLE-CASE *PRINT-CASE* Symbol-name Output~
~%--------------------------------------------------~
~%")
(dolist (readtable-case '(:upcase :downcase :preserve :invert))
(setf (readtable-case *readtable*) readtable-case)
(dolist (print-case '(:upcase :downcase :capitalize))
(dolist (symbol '(|ZEBRA| |Zebra| |zebra|))
(setq *print-case* print-case)
(format t "~&:~A~15T:~A~29T~A~42T~A"
(string-upcase readtable-case)
(string-upcase print-case)
(symbol-name symbol)
(prin1-to-string symbol)))))))
READTABLE-CASE *PRINT-CASE* Symbol-name Output
--------------------------------------------------
:UPCASE :UPCASE ZEBRA ZEBRA
:UPCASE :UPCASE Zebra |Zebra|
:UPCASE :UPCASE zebra |zebra|
:UPCASE :DOWNCASE ZEBRA zebra
:UPCASE :DOWNCASE Zebra |Zebra|
:UPCASE :DOWNCASE zebra |zebra|
:UPCASE :CAPITALIZE ZEBRA Zebra
:UPCASE :CAPITALIZE Zebra |Zebra|
:UPCASE :CAPITALIZE zebra |zebra|
:DOWNCASE :UPCASE ZEBRA |ZEBRA|
:DOWNCASE :UPCASE Zebra |Zebra|
:DOWNCASE :UPCASE zebra ZEBRA
:DOWNCASE :DOWNCASE ZEBRA |ZEBRA|
:DOWNCASE :DOWNCASE Zebra |Zebra|
:DOWNCASE :DOWNCASE zebra zebra
:DOWNCASE :CAPITALIZE ZEBRA |ZEBRA|
:DOWNCASE :CAPITALIZE Zebra |Zebra|
:DOWNCASE :CAPITALIZE zebra Zebra
:PRESERVE :UPCASE ZEBRA ZEBRA
:PRESERVE :UPCASE Zebra Zebra
:PRESERVE :UPCASE zebra zebra
:PRESERVE :DOWNCASE ZEBRA ZEBRA
:PRESERVE :DOWNCASE Zebra Zebra
:PRESERVE :DOWNCASE zebra zebra
:PRESERVE :CAPITALIZE ZEBRA ZEBRA
:PRESERVE :CAPITALIZE Zebra Zebra
:PRESERVE :CAPITALIZE zebra zebra
:INVERT :UPCASE ZEBRA zebra
:INVERT :UPCASE Zebra Zebra
:INVERT :UPCASE zebra ZEBRA
:INVERT :DOWNCASE ZEBRA zebra
:INVERT :DOWNCASE Zebra Zebra
:INVERT :DOWNCASE zebra ZEBRA
:INVERT :CAPITALIZE ZEBRA zebra
:INVERT :CAPITALIZE Zebra Zebra
:INVERT :CAPITALIZE zebra ZEBRA
(a . (b . ((c . (d . nil)) . (e . nil))))
(a b (c d) e)
(a . b) ;A dotted pair of a and b
(a.b) ;A list of one element, the symbol named a.b
(a. b) ;A list of two elements a. and b
(a .b) ;A list of two elements a and .b
(a b . c) ;A dotted list of a and b with c at the end; two conses
.iot ;The symbol whose name is .iot
(. b) ;Invalid -- an error is signaled if an attempt is made to read
;this syntax.
(a .) ;Invalid -- an error is signaled.
(a .. b) ;Invalid -- an error is signaled.
(a . . b) ;Invalid -- an error is signaled.
(a b c ...) ;Invalid -- an error is signaled.
(a \. b) ;A list of three elements a, ., and b
(a |.| b) ;A list of three elements a, ., and b
(a \... b) ;A list of three elements a, ..., and b
(a |...| b) ;A list of three elements a, ..., and b
% #3A(
% ((#\s #\t #\o #\p) (#\s #\p #\o #\t))
% ((#\p #\o #\s #\t) (#\p #\o #\t #\s))
% ((#\t #\o #\p #\s) (#\o #\p #\t #\s)))
%
% #3A(("stop" "spot") ("post" "pots") ("tops" "opts"))
%
(let ((a (make-array '(3 3)))
(*print-pretty* t)
(*print-array* t))
(dotimes (i 3) (dotimes (j 3) (setf (aref a i j) (format nil "<~D,~D>" i j))))
(print a)
(print (make-array 9 :displaced-to a)))
\OUT #2A(("<0,0>" "<0,1>" "<0,2>")
\OUT ("<1,0>" "<1,1>" "<1,2>")
\OUT ("<2,0>" "<2,1>" "<2,2>"))
\OUT #("<0,0>" "<0,1>" "<0,2>" "<1,0>" "<1,1>" "<1,2>" "<2,0>" "<2,1>" "<2,2>")
→ #<ARRAY 9 indirect 36363476>
% #S(RANDOM-STATE DATA #(14 49 98436589 786345 8734658324 ... ))
%
#S(RANDOM-STATE :DATA #(14 49 98436589 786345 8734658324 ... ))
#S(\param{structure-name} \star{\curly{\param{slot-key} \param{slot-value}}})
(let ((*print-escape* t)) (fresh-line) (write #\a))
\OUT #\a
→ #\a
(let ((*print-escape* nil) (*print-readably* nil))
(fresh-line)
(write #\a))
\OUT a
→ #\a
(progn (fresh-line) (prin1 #\a))
\OUT #\a
→ #\a
(progn (fresh-line) (print #\a))
\OUT
\OUT #\a
→ #\a
(progn (fresh-line) (princ #\a))
\OUT a
→ #\a
\medbreak
(dolist (val '(t nil))
(let ((*print-escape* val) (*print-readably* val))
(print '#\a)
(prin1 #\a) (write-char #\Space)
(princ #\a) (write-char #\Space)
(write #\a)))
\OUT #\a #\a a #\a
\OUT #\a #\a a a
→ NIL
\medbreak
(progn (fresh-line) (write '(let ((a 1) (b 2)) (+ a b))))
\OUT (LET ((A 1) (B 2)) (+ A B))
→ (LET ((A 1) (B 2)) (+ A B))
\medbreak
(progn (fresh-line) (pprint '(let ((a 1) (b 2)) (+ a b))))
\OUT (LET ((A 1)
\OUT (B 2))
\OUT (+ A B))
→ (LET ((A 1) (B 2)) (+ A B))
\medbreak
(progn (fresh-line)
(write '(let ((a 1) (b 2)) (+ a b)) :pretty t))
\OUT (LET ((A 1)
\OUT (B 2))
\OUT (+ A B))
→ (LET ((A 1) (B 2)) (+ A B))
\medbreak
(with-output-to-string (s)
(write 'write :stream s)
(prin1 'prin1 s))
→ "WRITEPRIN1"
(defun test-readtable-case-reading ()
(let ((*readtable* (copy-readtable nil)))
(format t "READTABLE-CASE Input Symbol-name~
~%-----------------------------------~
~%")
(dolist (readtable-case '(:upcase :downcase :preserve :invert))
(setf (readtable-case *readtable*) readtable-case)
(dolist (input '("ZEBRA" "Zebra" "zebra"))
(format t "~&:~A~16T~A~24T~A"
(string-upcase readtable-case)
input
(symbol-name (read-from-string input)))))))
READTABLE-CASE Input Symbol-name
-------------------------------------
:UPCASE ZEBRA ZEBRA
:UPCASE Zebra ZEBRA
:UPCASE zebra ZEBRA
:DOWNCASE ZEBRA zebra
:DOWNCASE Zebra zebra
:DOWNCASE zebra zebra
:PRESERVE ZEBRA ZEBRA
:PRESERVE Zebra Zebra
:PRESERVE zebra zebra
:INVERT ZEBRA zebra
:INVERT Zebra Zebra
:INVERT zebra ZEBRA
(cons '#3=(p q r) '(x y . #3#))
(set-macro-character #\' ;incorrect
#'(lambda (stream char)
(declare (ignore char))
(list 'quote (read stream))))
(set-macro-character #\' ;correct
#'(lambda (stream char)
(declare (ignore char))
(list 'quote (read stream t nil t))))
;; The following examples assume the readtable case of *readtable*
;; and *print-case* are both :upcase.
(eq 'abc 'ABC) → T
(eq 'abc '|ABC|) → T
(eq 'abc 'a|B|c) → T
(eq 'abc '|abc|) → NIL
;; The following examples assume the readtable case of *readtable*
;; and *print-case* are both :upcase.
(eq 'abc '\A\B\C) → T
(eq 'abc 'a\Bc) → T
(eq 'abc '\ABC) → T
(eq 'abc '\abc) → NIL
(length '(this-that)) → 1
(length '(this - that)) → 3
(length '(a
b)) → 2
(+ 34) → 34
(+ 3 4) → 7
(remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'equal)
→ (foo bar "BAR" "foo" "bar")
(remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'equalp)
→ (foo bar "BAR" "bar")
(remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'string-equal)
→ (bar "BAR" "bar")
(remove "FOO" '(foo bar "FOO" "BAR" "foo" "bar") :test #'string=)
→ (BAR "BAR" "foo" "bar")
(remove 1 '(1 1.0 #C(1.0 0.0) 2 2.0 #C(2.0 0.0)) :test-not #'eql)
→ (1)
(remove 1 '(1 1.0 #C(1.0 0.0) 2 2.0 #C(2.0 0.0)) :test-not #'=)
→ (1 1.0 #C(1.0 0.0))
(remove 1 '(1 1.0 #C(1.0 0.0) 2 2.0 #C(2.0 0.0)) :test (complement #'=))
→ (1 1.0 #C(1.0 0.0))
(count 1 '((one 1) (uno 1) (two 2) (dos 2)) :key #'cadr) → 2
(count 2.0 '(1 2 3) :test #'eql :key #'float) → 1
(count "FOO" (list (make-pathname :name "FOO" :type "X")
(make-pathname :name "FOO" :type "Y"))
:key #'pathname-name
:test #'equal)
→ 2
(count-if #'zerop '(1 #C(0.0 0.0) 0 0.0d0 0.0s0 3)) → 4
(remove-if-not #'symbolp '(0 1 2 3 4 5 6 7 8 9 A B C D E F))
→ (A B C D E F)
(remove-if (complement #'symbolp) '(0 1 2 3 4 5 6 7 8 9 A B C D E F))
→ (A B C D E F)
(count-if #'zerop '("foo" "" "bar" "" "" "baz" "quux") :key #'length)
→ 3
\256 25\64 1.0\E6 |100| 3\.14159 |3/4| 3\/4 5||
(vector double-float 100)
(vector double-float *)
(vector * 100)
% (array integer 3) ;Three-dimensional arrays of integers
% (array integer (* * *)) ;Three-dimensional arrays of integers
% (array * (4 5 6)) ;4-by-5-by-6 arrays
% (array character (3 *)) ;Two-dimensional arrays of characters that have
% ;three rows
% (array short-float \empty) ;Zero-rank arrays of short-floats
%
% (typep foo '(array character))
%
% (subtypep 'character (array-element-type foo))
%
(make-array '(4 2 3) :initial-contents
'(((a b c) (1 2 3))
((d e f) (3 1 2))
((g h i) (2 3 1))
((j k l) (0 0 0))))
(make-array 5) ;; Creates a one-dimensional array of five elements.
(make-array '(3 4) :element-type '(mod 16)) ;; Creates a
;;two-dimensional array, 3 by 4, with four-bit elements.
(make-array 5 :element-type 'single-float) ;; Creates an array of single-floats.
(make-array nil :initial-element nil) → #0ANIL
(make-array 4 :initial-element nil) → #(NIL NIL NIL NIL)
(make-array '(2 4)
:element-type '(unsigned-byte 2)
:initial-contents '((0 1 2 3) (3 2 1 0)))
→ #2A((0 1 2 3) (3 2 1 0))
(make-array 6
:element-type 'character
:initial-element #\a
:fill-pointer 3) → "aaa"
(setq a (make-array '(4 3)))
→ #<ARRAY 4x3 simple 32546632>
(dotimes (i 4)
(dotimes (j 3)
(setf (aref a i j) (list i 'x j '= (* i j)))))
→ NIL
(setq b (make-array 8 :displaced-to a
:displaced-index-offset 2))
→ #<ARRAY 8 indirect 32550757>
(dotimes (i 8)
(print (list i (aref b i))))
\OUT (0 (0 X 2 = 0))
\OUT (1 (1 X 0 = 0))
\OUT (2 (1 X 1 = 1))
\OUT (3 (1 X 2 = 2))
\OUT (4 (2 X 0 = 0))
\OUT (5 (2 X 1 = 2))
\OUT (6 (2 X 2 = 4))
\OUT (7 (3 X 0 = 0))
→ NIL
(setq a1 (make-array 50))
→ #<ARRAY 50 simple 32562043>
(setq b1 (make-array 20 :displaced-to a1 :displaced-index-offset 10))
→ #<ARRAY 20 indirect 32563346>
(length b1) → 20
(setq a2 (make-array 50 :fill-pointer 10))
→ #<ARRAY 50 fill-pointer 10 46100216>
(setq b2 (make-array 20 :displaced-to a2 :displaced-index-offset 10))
→ #<ARRAY 20 indirect 46104010>
(length a2) → 10
(length b2) → 20
(setq a3 (make-array 50 :fill-pointer 10))
→ #<ARRAY 50 fill-pointer 10 46105663>
(setq b3 (make-array 20 :displaced-to a3 :displaced-index-offset 10
:fill-pointer 5))
→ #<ARRAY 20 indirect, fill-pointer 5 46107432>
(length a3) → 10
(length b3) → 5
(adjust-array A ...)
(adjust-array A ... :displaced-to C)
(adjust-array A ... :displaced-to B)
(adjust-array A ... :displaced-to C)
(adjust-array A ... :displaced-to B)
(adjust-array A ... :displaced-to nil)
(adjustable-array-p
(setq ada (adjust-array
(make-array '(2 3)
:adjustable t
:initial-contents '((a b c) (1 2 3)))
'(4 6)))) → T
(array-dimensions ada) → (4 6)
(aref ada 1 1) → 2
(setq beta (make-array '(2 3) :adjustable t))
→ #2A((NIL NIL NIL) (NIL NIL NIL))
(adjust-array beta '(4 6) :displaced-to ada)
→ #2A((A B C NIL NIL NIL)
(1 2 3 NIL NIL NIL)
(NIL NIL NIL NIL NIL NIL)
(NIL NIL NIL NIL NIL NIL))
(array-dimensions beta) → (4 6)
(aref beta 1 1) → 2
#2A(( alpha beta gamma delta )
( epsilon zeta eta theta )
( iota kappa lambda mu )
( nu xi omicron pi ))
(adjust-array m '(3 5) :initial-element 'baz)
#2A(( alpha beta gamma delta baz )
( epsilon zeta eta theta baz )
( iota kappa lambda mu baz ))
(adjustable-array-p
(make-array 5
:element-type 'character
:adjustable t
:fill-pointer 3)) → T
(adjustable-array-p (make-array 4)) → implementation-dependent
(aref (setq alpha (make-array 4)) 3) → implementation-dependent
(setf (aref alpha 3) 'sirens) → SIRENS
(aref alpha 3) → SIRENS
(aref (setq beta (make-array '(2 4)
:element-type '(unsigned-byte 2)
:initial-contents '((0 1 2 3) (3 2 1 0))))
1 2) → 1
(setq gamma '(0 2))
(apply #'aref beta gamma) → 2
(setf (apply #'aref beta gamma) 3) → 3
(apply #'aref beta gamma) → 3
(aref beta 0 2) → 3
(array-dimension (make-array 4) 0) → 4
(array-dimension (make-array '(2 3)) 1) → 3
(array-dimension array n) \EQ (nth n (array-dimensions array))
(array-dimensions (make-array 4)) → (4)
(array-dimensions (make-array '(2 3))) → (2 3)
(array-dimensions (make-array 4 :fill-pointer 2)) → (4)
(array-element-type (make-array 4)) → T
(array-element-type (make-array 12 :element-type '(unsigned-byte 8)))
→ implementation-dependent
(array-element-type (make-array 12 :element-type '(unsigned-byte 5)))
→ implementation-dependent
(array-element-type (make-array 5 :element-type '(mod 5)))
(array-has-fill-pointer-p (make-array 4)) → implementation-dependent
(array-has-fill-pointer-p (make-array '(2 3))) → NIL
(array-has-fill-pointer-p
(make-array 8
:fill-pointer 2
:initial-element 'filler)) → T
(setq a1 (make-array 5)) → #<ARRAY 5 simple 46115576>
(setq a2 (make-array 4 :displaced-to a1
:displaced-index-offset 1))
→ #<ARRAY 4 indirect 46117134>
(array-displacement a2)
→ #<ARRAY 5 simple 46115576>, 1
(setq a3 (make-array 2 :displaced-to a2
:displaced-index-offset 2))
→ #<ARRAY 2 indirect 46122527>
(array-displacement a3)
→ #<ARRAY 4 indirect 46117134>, 2
(setq a (make-array '(7 11) :element-type 'string-char))
(array-in-bounds-p a 0 0) → T
(array-in-bounds-p a 6 10) → T
(array-in-bounds-p a 0 -1) → NIL
(array-in-bounds-p a 0 11) → NIL
(array-in-bounds-p a 7 0) → NIL
(array-in-bounds-p array subscripts)
\EQ (and (not (some #'minusp (list subscripts)))
(every #'< (list subscripts) (array-dimensions array)))
(array-rank (make-array '())) → 0
(array-rank (make-array 4)) → 1
(array-rank (make-array '(4))) → 1
(array-rank (make-array '(2 3))) → 2
(setq a (make-array '(4 7) :element-type '(unsigned-byte 8)))
(array-row-major-index a 1 2) → 9
(array-row-major-index
(make-array '(2 3 4)
:element-type '(unsigned-byte 8)
:displaced-to a
:displaced-index-offset 4)
0 2 1) → 9
(defun array-row-major-index (a &rest subscripts)
(apply #'+ (maplist #'(lambda (x y)
(* (car x) (apply #'* (cdr y))))
subscripts
(array-dimensions a))))
(array-total-size (make-array 4)) → 4
(array-total-size (make-array 4 :fill-pointer 2)) → 4
(array-total-size (make-array 0)) → 0
(array-total-size (make-array '(4 2))) → 8
(array-total-size (make-array '(4 0))) → 0
(array-total-size (make-array '())) → 1
(array-total-size x)
\EQ (apply #'* (array-dimensions x))
\EQ (reduce #'* (array-dimensions x))
(arrayp (make-array '(2 3 4) :adjustable t)) → T
(arrayp (make-array 6)) → T
(arrayp #*1011) → T
(arrayp "hi") → T
(arrayp 'hi) → NIL
(arrayp 12) → NIL
(arrayp \param{object}) \EQ (typep \param{object} 'array)
(setq a (make-array 8 :fill-pointer 4)) → #(NIL NIL NIL NIL)
(fill-pointer a) → 4
(dotimes (i (length a)) (setf (aref a i) (* i i))) → NIL
a → #(0 1 4 9)
(setf (fill-pointer a) 3) → 3
(fill-pointer a) → 3
a → #(0 1 4)
(setf (fill-pointer a) 8) → 8
a → #(0 1 4 9 NIL NIL NIL NIL)
(row-major-aref array index) \EQ
(aref (make-array (array-total-size array)
:displaced-to array
:element-type (array-element-type array))
index)
(aref array i1 i2 ...) \EQ
(row-major-aref array (array-row-major-index array i1 i2))
(defun upgraded-array-element-type (type &optional environment)
(array-element-type (make-array 0 :element-type type)))
(simple-vector-p (make-array 6)) → T
(simple-vector-p "aaaaaa") → NIL
(simple-vector-p (make-array 6 :fill-pointer t)) → NIL
(simple-vector-p \param{object}) \EQ (typep \param{object} 'simple-vector)
(simple-vector-p (setq v (vector 1 2 'sirens))) → T
(svref v 0) → 1
(svref v 2) → SIRENS
(setf (svref v 1) 'newcomer) → NEWCOMER
v → #(1 NEWCOMER SIRENS)
(svref \param{v} \param{i}) \EQ (aref (the simple-vector \param{v}) \param{i})
(arrayp (setq v (vector 1 2 'sirens))) → T
(vectorp v) → T
(simple-vector-p v) → T
(length v) → 3
(vector a\ssso a\ssst ... a\sssn)
\EQ (make-array (list \i{n}) :element-type t
:initial-contents
(list a\ssso a\ssst ... a\sssn))
(vector-push (setq fable (list 'fable))
(setq fa (make-array 8
:fill-pointer 2
:initial-element 'sisyphus))) → 2
(fill-pointer fa) → 3
(eq (vector-pop fa) fable) → T
(vector-pop fa) → SISYPHUS
(fill-pointer fa) → 1
(vector-push (setq fable (list 'fable))
(setq fa (make-array 8
:fill-pointer 2
:initial-element 'first-one))) → 2
(fill-pointer fa) → 3
(eq (aref fa 2) fable) → T
(vector-push-extend #\X
(setq aa
(make-array 5
:element-type 'character
:adjustable t
:fill-pointer 3))) → 3
(fill-pointer aa) → 4
(vector-push-extend #\Y aa 4) → 4
(array-total-size aa) → at least 5
(vector-push-extend #\Z aa 4) → 5
(array-total-size aa) → 9 ;(or more)
(vectorp "aaaaaa") → T
(vectorp (make-array 6 :fill-pointer t)) → T
(vectorp (make-array '(2 3 4))) → NIL
(vectorp #*11) → T
(vectorp #b11) → NIL
(vectorp \param{object}) \EQ (typep \param{object} 'vector)
(bit (setq ba (make-array 8
:element-type 'bit
:initial-element 1))
3) → 1
(setf (bit ba 3) 0) → 0
(bit ba 3) → 0
(sbit ba 5) → 1
(setf (sbit ba 5) 1) → 1
(sbit ba 5) → 1
(bit-and (setq ba #*11101010) #*01101011) → #*01101010
(bit-and #*1100 #*1010) → #*1000
(bit-andc1 #*1100 #*1010) → #*0010
(setq rba (bit-andc2 ba #*00110011 t)) → #*11001000
(eq rba ba) → T
(bit-not (setq ba #*11101010)) → #*00010101
(setq rba (bit-not ba
(setq tba (make-array 8
:element-type 'bit))))
→ #*00010101
(equal rba tba) → T
(bit-xor #*1100 #*1010) → #*0110
(bit-vector-p (make-array 6
:element-type 'bit
:fill-pointer t)) → T
(bit-vector-p #*) → T
(bit-vector-p (make-array 6)) → NIL
(bit-vector-p \param{object}) \EQ (typep \param{object} 'bit-vector)
(simple-bit-vector-p (make-array 6)) → NIL
(simple-bit-vector-p #*) → T
(simple-bit-vector-p \param{object}) \EQ (typep \param{object} 'simple-bit-vector)
(char= #\d #\d) → T
(char= #\A #\a) → NIL
(char= #\d #\x) → NIL
(char= #\d #\D) → NIL
(char/= #\d #\d) → NIL
(char/= #\d #\x) → T
(char/= #\d #\D) → T
(char= #\d #\d #\d #\d) → T
(char/= #\d #\d #\d #\d) → NIL
(char= #\d #\d #\x #\d) → NIL
(char/= #\d #\d #\x #\d) → NIL
(char= #\d #\y #\x #\c) → NIL
(char/= #\d #\y #\x #\c) → T
(char= #\d #\c #\d) → NIL
(char/= #\d #\c #\d) → NIL
(char< #\d #\x) → T
(char<= #\d #\x) → T
(char< #\d #\d) → NIL
(char<= #\d #\d) → T
(char< #\a #\e #\y #\z) → T
(char<= #\a #\e #\y #\z) → T
(char< #\a #\e #\e #\y) → NIL
(char<= #\a #\e #\e #\y) → T
(char> #\e #\d) → T
(char>= #\e #\d) → T
(char> #\d #\c #\b #\a) → T
(char>= #\d #\c #\b #\a) → T
(char> #\d #\d #\c #\a) → NIL
(char>= #\d #\d #\c #\a) → T
(char> #\e #\d #\b #\c #\a) → NIL
(char>= #\e #\d #\b #\c #\a) → NIL
(char> #\z #\A) → implementation-dependent
(char> #\Z #\a) → implementation-dependent
(char-equal #\A #\a) → T
(stable-sort (list #\b #\A #\B #\a #\c #\C) #'char-lessp)
→ (#\A #\a #\b #\B #\c #\C)
(stable-sort (list #\b #\A #\B #\a #\c #\C) #'char<)
→ (#\A #\B #\C #\a #\b #\c) ;Implementation A
→ (#\a #\b #\c #\A #\B #\C) ;Implementation B
→ (#\a #\A #\b #\B #\c #\C) ;Implementation C
→ (#\A #\a #\B #\b #\C #\c) ;Implementation D
→ (#\A #\B #\a #\b #\C #\c) ;Implementation E
(character #\a) → #\a
(character "a") → #\a
(character 'a) → #\A
(character '\a) → #\a
(character 65.) is an error.
(character 'apple) is an error.
(character \param{object}) \EQ (coerce \param{object} 'character)
(characterp #\a) → T
(characterp 'a) → NIL
(characterp "a") → NIL
(characterp 65.) → NIL
(characterp #\Newline) → T
;; This next example presupposes an implementation
;; in which #\Rubout is an implementation-defined character.
(characterp #\Rubout) → T
(characterp \param{object}) \EQ (typep \param{object} 'character)
(alpha-char-p #\a) → T
(alpha-char-p #\5) → NIL
(alpha-char-p #\Newline) → NIL
;; This next example presupposes an implementation
;; in which #\<alfa> is a defined character.
(alpha-char-p #\<alfa>) → implementation-dependent
(alphanumericp #\Z) → T
(alphanumericp #\9) → T
(alphanumericp #\Newline) → NIL
(alphanumericp #\#) → NIL
(alphanumericp x)
\EQ (or (alpha-char-p x) (not (null (digit-char-p x))))
(digit-char 0) → #\0
(digit-char 10 11) → #\A
(digit-char 10 10) → NIL
(digit-char 7) → #\7
(digit-char 12) → NIL
(digit-char 12 16) → #\C ;not #\c
(digit-char 6 2) → NIL
(digit-char 1 2) → #\1
(digit-char-p #\5) → 5
(digit-char-p #\5 2) → NIL
(digit-char-p #\A) → NIL
(digit-char-p #\a) → NIL
(digit-char-p #\A 11) → 10
(digit-char-p #\a 11) → 10
(mapcar #'(lambda (radix)
(map 'list #'(lambda (x) (digit-char-p x radix))
"059AaFGZ"))
'(2 8 10 16 36))
→ ((0 NIL NIL NIL NIL NIL NIL NIL)
(0 5 NIL NIL NIL NIL NIL NIL)
(0 5 9 NIL NIL NIL NIL NIL)
(0 5 9 10 10 15 NIL NIL)
(0 5 9 10 10 15 16 35))
(graphic-char-p #\G) → T
(graphic-char-p #\#) → T
(graphic-char-p #\Space) → T
(graphic-char-p #\Newline) → NIL
(standard-char-p #\Space) → T
(standard-char-p #\~) → T
;; This next example presupposes an implementation
;; in which #\Bell is a defined character.
(standard-char-p #\Bell) → NIL
(char-upcase #\a) → #\A
(char-upcase #\A) → #\A
(char-downcase #\a) → #\a
(char-downcase #\A) → #\a
(char-upcase #\9) → #\9
(char-downcase #\9) → #\9
(char-upcase #\@) → #\@
(char-downcase #\@) → #\@
;; Note that this next example might run for a very long time in
;; some implementations if CHAR-CODE-LIMIT happens to be very large
;; for that implementation.
(dotimes (code char-code-limit)
(let ((char (code-char code)))
(when char
(unless (cond ((upper-case-p char) (char= (char-upcase (char-downcase char)) char))
((lower-case-p char) (char= (char-downcase (char-upcase char)) char))
(t (and (char= (char-upcase (char-downcase char)) char)
(char= (char-downcase (char-upcase char)) char))))
(return char)))))
→ NIL
(upper-case-p #\A) → T
(upper-case-p #\a) → NIL
(both-case-p #\a) → T
(both-case-p #\5) → NIL
(lower-case-p #\5) → NIL
(upper-case-p #\5) → NIL
;; This next example presupposes an implementation
;; in which #\Bell is an implementation-defined character.
(lower-case-p #\Bell) → NIL
;; An implementation using ASCII character encoding
;; might return these values:
(char-code #\$) → 36
(char-code #\a) → 97
(char= \i{c1} \i{c2}) \EQ (= (char-int \i{c1}) (char-int \i{c2}))
(char-int #\A) → 65 ; implementation A
(char-int #\A) → 577 ; implementation B
(char-int #\A) → 262145 ; implementation C
(code-char 65.) → #\A ;in an implementation using ASCII codes
(code-char (char-code #\Space)) → #\Space ;in any implementation
(char-name #\ ) → "Space"
(char-name #\Space) → "Space"
(char-name #\Page) → "Page"
(char-name #\a)
→ NIL
OR=> "LOWERCASE-a"
OR=> "Small-A"
OR=> "LA01"
(char-name #\A)
→ NIL
OR=> "UPPERCASE-A"
OR=> "Capital-A"
OR=> "LA02"
;; Even though its CHAR-NAME can vary, #\A prints as #\A
(prin1-to-string (read-from-string (format nil "#\\~A" (or (char-name #\A) "A"))))
→ "#\\A"
(name-char 'space) → #\Space
(name-char "space") → #\Space
(name-char "Space") → #\Space
(let ((x (char-name #\a)))
(or (not x) (eql (name-char x) #\a))) → T
(setq x (make-array '(3 5) :initial-element 3))
→ #2A((3 3 3 3 3) (3 3 3 3 3) (3 3 3 3 3))
(setq y (make-array '(3 5) :initial-element 7))
→ #2A((7 7 7 7 7) (7 7 7 7 7) (7 7 7 7 7))
(defun matrix-multiply (a b)
(let ((*print-array* nil))
(assert (and (= (array-rank a) (array-rank b) 2)
(= (array-dimension a 1) (array-dimension b 0)))
(a b)
"Cannot multiply ~S by ~S." a b)
(really-matrix-multiply a b))) → MATRIX-MULTIPLY
(matrix-multiply x y)
\OUT Correctable error in MATRIX-MULTIPLY:
\OUT Cannot multiply #<ARRAY ...> by #<ARRAY ...>.
\OUT Restart options:
\OUT 1: You will be prompted for one or more new values.
\OUT 2: Top level.
\OUT Debug> \IN{:continue 1}
\OUT Value for A: \IN{x}
\OUT Value for B: \IN{(make-array '(5 3) :initial-element 6)}
→ #2A((54 54 54 54 54)
(54 54 54 54 54)
(54 54 54 54 54)
(54 54 54 54 54)
(54 54 54 54 54))
(defun double-safely (x) (assert (numberp x) (x)) (+ x x))
(double-safely 4)
→ 8
(double-safely t)
\OUT Correctable error in DOUBLE-SAFELY: The value of (NUMBERP X) must be non-NIL.
\OUT Restart options:
\OUT 1: You will be prompted for one or more new values.
\OUT 2: Top level.
\OUT Debug> \IN{:continue 1}
\OUT Value for X: \IN{7}
→ 14
(defun factorial (x)
(cond ((or (not (typep x 'integer)) (minusp x))
(error "~S is not a valid argument to FACTORIAL." x))
((zerop x) 1)
(t (* x (factorial (- x 1))))))
→ FACTORIAL
(factorial 20)
→ 2432902008176640000
(factorial -1)
\OUT Error: -1 is not a valid argument to FACTORIAL.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Return to Lisp Toplevel.
\OUT Debug>
(setq a 'fred)
→ FRED
(if (numberp a) (1+ a) (error "~S is not a number." A))
\OUT Error: FRED is not a number.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Return to Lisp Toplevel.
\OUT Debug> \IN{:Continue 1}
\OUT Return to Lisp Toplevel.
(define-condition not-a-number (error)
((argument :reader not-a-number-argument :initarg :argument))
(:report (lambda (condition stream)
(format stream "~S is not a number."
(not-a-number-argument condition)))))
→ NOT-A-NUMBER
(if (numberp a) (1+ a) (error 'not-a-number :argument a))
\OUT Error: FRED is not a number.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Return to Lisp Toplevel.
\OUT Debug> \IN{:Continue 1}
\OUT Return to Lisp Toplevel.
(defun wargames:no-win-scenario ()
(if (error "pushing the button would be stupid."))
(push-the-button))
(defun real-sqrt (n)
(when (minusp n)
(setq n (- n))
(cerror "Return sqrt(~D) instead." "Tried to take sqrt(-~D)." n))
(sqrt n))
(real-sqrt 4)
→ 2.0
(real-sqrt -9)
\OUT Correctable error in REAL-SQRT: Tried to take sqrt(-9).
\OUT Restart options:
\OUT 1: Return sqrt(9) instead.
\OUT 2: Top level.
\OUT Debug> \IN{:continue 1}
→ 3.0
(define-condition not-a-number (error)
((argument :reader not-a-number-argument :initarg :argument))
(:report (lambda (condition stream)
(format stream "~S is not a number."
(not-a-number-argument condition)))))
(defun assure-number (n)
(loop (when (numberp n) (return n))
(cerror "Enter a number."
'not-a-number :argument n)
(format t "~&Type a number: ")
(setq n (read))
(fresh-line)))
(assure-number 'a)
\OUT Correctable error in ASSURE-NUMBER: A is not a number.
\OUT Restart options:
\OUT 1: Enter a number.
\OUT 2: Top level.
\OUT Debug> \IN{:continue 1}
\OUT Type a number: \IN{1/2}
→ 1/2
(defun assure-large-number (n)
(loop (when (and (numberp n) (> n 73)) (return n))
(cerror "Enter a number~:[~; a bit larger than ~D~]."
"~*~A is not a large number."
(numberp n) n)
(format t "~&Type a large number: ")
(setq n (read))
(fresh-line)))
(assure-large-number 10000)
→ 10000
(assure-large-number 'a)
\OUT Correctable error in ASSURE-LARGE-NUMBER: A is not a large number.
\OUT Restart options:
\OUT 1: Enter a number.
\OUT 2: Top level.
\OUT Debug> \IN{:continue 1}
\OUT Type a large number: \IN{88}
→ 88
(assure-large-number 37)
\OUT Correctable error in ASSURE-LARGE-NUMBER: 37 is not a large number.
\OUT Restart options:
\OUT 1: Enter a number a bit larger than 37.
\OUT 2: Top level.
\OUT Debug> \IN{:continue 1}
\OUT Type a large number: \IN{259}
→ 259
(define-condition not-a-large-number (error)
((argument :reader not-a-large-number-argument :initarg :argument))
(:report (lambda (condition stream)
(format stream "~S is not a large number."
(not-a-large-number-argument condition)))))
(defun assure-large-number (n)
(loop (when (and (numberp n) (> n 73)) (return n))
(cerror "Enter a number~3*~:[~; a bit larger than ~*~D~]."
'not-a-large-number
:argument n
:ignore (numberp n)
:ignore n
:allow-other-keys t)
(format t "~&Type a large number: ")
(setq n (read))
(fresh-line)))
(assure-large-number 'a)
\OUT Correctable error in ASSURE-LARGE-NUMBER: A is not a large number.
\OUT Restart options:
\OUT 1: Enter a number.
\OUT 2: Top level.
\OUT Debug> \IN{:continue 1}
\OUT Type a large number: \IN{88}
→ 88
(assure-large-number 37)
\OUT Correctable error in ASSURE-LARGE-NUMBER: A is not a large number.
\OUT Restart options:
\OUT 1: Enter a number a bit larger than 37.
\OUT 2: Top level.
\OUT Debug> \IN{:continue 1}
\OUT Type a large number: \IN{259}
→ 259
(cerror "enter a new value to replace ~*~s"
'not-a-number
:argument a)
(setq aardvarks '(sam harry fred))
→ (SAM HARRY FRED)
(check-type aardvarks (array * (3)))
\OUT Error: The value of AARDVARKS, (SAM HARRY FRED),
\OUT is not a 3-long array.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Specify a value to use instead.
\OUT 2: Return to Lisp Toplevel.
\OUT Debug> \IN{:CONTINUE 1}
\OUT Use Value: \IN{#(SAM FRED HARRY)}
→ NIL
aardvarks
→ #<ARRAY-T-3 13571>
(map 'list #'identity aardvarks)
→ (SAM FRED HARRY)
(setq aardvark-count 'foo)
→ FOO
(check-type aardvark-count (integer 0 *) "A positive integer")
\OUT Error: The value of AARDVARK-COUNT, FOO, is not a positive integer.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Specify a value to use instead.
\OUT 2: Top level.
\OUT Debug> \IN{:CONTINUE 2}
(defmacro define-adder (name amount)
(check-type name (and symbol (not null)) "a name for an adder function")
(check-type amount integer)
`(defun ,name (x) (+ x ,amount)))
(macroexpand '(define-adder add3 3))
→ (defun add3 (x) (+ x 3))
(macroexpand '(define-adder 7 7))
\OUT Error: The value of NAME, 7, is not a name for an adder function.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Specify a value to use instead.
\OUT 2: Top level.
\OUT Debug> \IN{:Continue 1}
\OUT Specify a value to use instead.
\OUT Type a form to be evaluated and used instead: \IN{'ADD7}
→ (defun add7 (x) (+ x 7))
(macroexpand '(define-adder add5 something))
\OUT Error: The value of AMOUNT, SOMETHING, is not an integer.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Specify a value to use instead.
\OUT 2: Top level.
\OUT Debug> \IN{:Continue 1}
\OUT Type a form to be evaluated and used instead: \IN{5}
→ (defun add5 (x) (+ x 5))
(check-type \param{place} \param{typespec})
\EQ (assert (typep \param{place} '\param{typespec}) (\param{place})
'type-error :datum \param{place} :expected-type '\param{typespec})
(defun handle-division-conditions (condition)
(format t "Considering condition for division condition handling~%")
(when (and (typep condition 'arithmetic-error)
(eq '/ (arithmetic-error-operation condition)))
(invoke-debugger condition)))
HANDLE-DIVISION-CONDITIONS
(defun handle-other-arithmetic-errors (condition)
(format t "Considering condition for arithmetic condition handling~%")
(when (typep condition 'arithmetic-error)
(abort)))
HANDLE-OTHER-ARITHMETIC-ERRORS
(define-condition a-condition-with-no-handler (condition) ())
A-CONDITION-WITH-NO-HANDLER
(signal 'a-condition-with-no-handler)
NIL
(handler-bind ((condition #'handle-division-conditions)
(condition #'handle-other-arithmetic-errors))
(signal 'a-condition-with-no-handler))
Considering condition for division condition handling
Considering condition for arithmetic condition handling
NIL
(handler-bind ((arithmetic-error #'handle-division-conditions)
(arithmetic-error #'handle-other-arithmetic-errors))
(signal 'arithmetic-error :operation '* :operands '(1.2 b)))
Considering condition for division condition handling
Considering condition for arithmetic condition handling
Back to Lisp Toplevel
(setq foo (make-condition 'simple-condition
:format-control "Hi ~S"
:format-arguments '(ho)))
→ #<SIMPLE-CONDITION 26223553>
(apply #'format nil (simple-condition-format-control foo)
(simple-condition-format-arguments foo))
→ "Hi HO"
(defun foo (x)
(let ((result (* x 2)))
(if (not (typep result 'fixnum))
(warn "You're using very big numbers."))
result))
→ FOO
(foo 3)
→ 6
(foo most-positive-fixnum)
\OUT Warning: You're using very big numbers.
→ 4294967294
(setq *break-on-signals* t)
→ T
(foo most-positive-fixnum)
\OUT Break: Caveat emptor.
\OUT To continue, type :CONTINUE followed by an option number.
\OUT 1: Return from Break.
\OUT 2: Abort to Lisp Toplevel.
\OUT Debug> :continue 1
\OUT Warning: You're using very big numbers.
→ 4294967294
(ignore-errors ;Normally, this would suppress debugger entry
(handler-bind ((error #'invoke-debugger)) ;But this forces debugger entry
(error "Foo.")))
Debug: Foo.
To continue, type :CONTINUE followed by an option number:
1: Return to Lisp Toplevel.
Debug>
(break "You got here with arguments: ~:S." '(FOO 37 A))
\OUT BREAK: You got here with these arguments: FOO, 37, A.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Return from BREAK.
\OUT 2: Top level.
\OUT Debug> :CONTINUE 1
\OUT Return from BREAK.
→ NIL
(defun break (&optional (format-control "Break") &rest format-arguments)
(with-simple-restart (continue "Return from BREAK.")
(let ((*debugger-hook* nil))
(invoke-debugger
(make-condition 'simple-condition
:format-control format-control
:format-arguments format-arguments))))
nil)
(defun one-of (choices &optional (prompt "Choice"))
(let ((n (length choices)) (i))
(do ((c choices (cdr c)) (i 1 (+ i 1)))
((null c))
(format t "~&[~D] ~A~%" i (car c)))
(do () ((typep i `(integer 1 ,n)))
(format t "~&~A: " prompt)
(setq i (read))
(fresh-line))
(nth (- i 1) choices)))
(defun my-debugger (condition me-or-my-encapsulation)
(format t "~&Fooey: ~A" condition)
(let ((restart (one-of (compute-restarts))))
(if (not restart) (error "My debugger got an error."))
(let ((*debugger-hook* me-or-my-encapsulation))
(invoke-restart-interactively restart))))
(let ((*debugger-hook* #'my-debugger))
(+ 3 'a))
\OUT Fooey: The argument to +, A, is not a number.
\OUT [1] Supply a replacement for A.
\OUT [2] Return to Cloe Toplevel.
\OUT Choice: 1
\OUT Form to evaluate and use: (+ 5 'b)
\OUT Fooey: The argument to +, B, is not a number.
\OUT [1] Supply a replacement for B.
\OUT [2] Supply a replacement for A.
\OUT [3] Return to Cloe Toplevel.
\OUT Choice: 1
\OUT Form to evaluate and use: 1
→ 9
*break-on-signals* → NIL
(ignore-errors (error 'simple-error :format-control "Fooey!"))
→ NIL, #<SIMPLE-ERROR 32207172>
(let ((*break-on-signals* 'error))
(ignore-errors (error 'simple-error :format-control "Fooey!")))
\OUT Break: Fooey!
\OUT BREAK entered because of *BREAK-ON-SIGNALS*.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Continue to signal.
\OUT 2: Top level.
\OUT Debug> \IN{:CONTINUE 1}
\OUT Continue to signal.
→ NIL, #<SIMPLE-ERROR 32212257>
(let ((*break-on-signals* 'error))
(error 'simple-error :format-control "Fooey!"))
\OUT Break: Fooey!
\OUT BREAK entered because of *BREAK-ON-SIGNALS*.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Continue to signal.
\OUT 2: Top level.
\OUT Debug> \IN{:CONTINUE 1}
\OUT Continue to signal.
\OUT Error: Fooey!
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Top level.
\OUT Debug> \IN{:CONTINUE 1}
\OUT Top level.
(handler-bind ((unbound-variable #'(lambda ...))
(error #'(lambda ...)))
...)
(defun trap-error-handler (condition)
(format *error-output* "~&~A~&" condition)
(throw 'trap-errors nil))
(defmacro trap-errors (&rest forms)
`(catch 'trap-errors
(handler-bind ((error #'trap-error-handler))
,@forms)))
(list (trap-errors (signal "Foo.") 1)
(trap-errors (error "Bar.") 2)
(+ 1 2))
\OUT Bar.
→ (1 NIL 3)
(handler-case \i{form}
(\i{typespec1} (\i{var1}) \i{form1})
(\i{typespec2} (\i{var2}) \i{form2}))
(\param{typespec} (\param{var}) (declare (ignore \param{var})) \param{form})
(defun assess-condition (condition)
(handler-case (signal condition)
(warning () "Lots of smoke, but no fire.")
((or arithmetic-error control-error cell-error stream-error)
(condition)
(format nil "~S looks especially bad." condition))
(serious-condition (condition)
(format nil "~S looks serious." condition))
(condition () "Hardly worth mentioning.")))
→ ASSESS-CONDITION
(assess-condition (make-condition 'stream-error :stream *terminal-io*))
→ "#<STREAM-ERROR 12352256> looks especially bad."
(define-condition random-condition (condition) ()
(:report (lambda (condition stream)
(declare (ignore condition))
(princ "Yow" stream))))
→ RANDOM-CONDITION
(assess-condition (make-condition 'random-condition))
→ "Hardly worth mentioning."
(handler-case form
(\i{type1} (\i{var1}) . \i{body1})
(\i{type2} (\i{var2}) . \i{body2}) ...)
(block #1=#:g0001
(let ((#2=#:g0002 nil))
(tagbody
(handler-bind ((\i{type1} #'(lambda (temp)
(setq #1# temp)
(go #3=#:g0003)))
(\i{type2} #'(lambda (temp)
(setq #2# temp)
(go #4=#:g0004))) ...)
(return-from #1# form))
#3# (return-from #1# (let ((\i{var1} #2#)) . \i{body1}))
#4# (return-from #1# (let ((\i{var2} #2#)) . \i{body2})) ...)))
(handler-case form
(\i{type1} \i{(var1)} . \i{body1})
...
(:no-error (\i{varN-1} \i{varN-2} ...) . \i{bodyN}))
(block #1=#:error-return
(multiple-value-call #'(lambda (\i{varN-1} \i{varN-2} ...) . \i{bodyN})
(block #2=#:normal-return
(return-from #1#
(handler-case (return-from #2# form)
(\i{type1} (\i{var1}) . \i{body1}) ...)))))
(defun load-init-file (program)
(let ((win nil))
(ignore-errors ;if this fails, don't enter debugger
(load (merge-pathnames (make-pathname :name program :type :lisp)
(user-homedir-pathname)))
(setq win t))
(unless win (format t "~&Init file failed to load.~%"))
win))
(load-init-file "no-such-program")
\OUT Init file failed to load.
NIL
(ignore-errors . \i{forms})
(handler-case (progn . \i{forms})
(error (condition) (values nil condition)))
(defmethod print-object ((x c) stream)
(if *print-escape* (call-next-method) (\param{report-name} x stream)))
(lambda (condition stream)
(declare (ignore condition))
(write-string \param{report-name} stream))
(define-condition peg/hole-mismatch
(blocks-world-error)
((peg-shape :initarg :peg-shape
:reader peg/hole-mismatch-peg-shape)
(hole-shape :initarg :hole-shape
:reader peg/hole-mismatch-hole-shape))
(:report (lambda (condition stream)
(format stream "A ~A peg cannot go in a ~A hole."
(peg/hole-mismatch-peg-shape condition)
(peg/hole-mismatch-hole-shape condition)))))
(define-condition machine-error
(error)
((machine-name :initarg :machine-name
:reader machine-error-machine-name))
(:report (lambda (condition stream)
(format stream "There is a problem with ~A."
(machine-error-machine-name condition)))))
(define-condition machine-not-available-error (machine-error) ()
(:report (lambda (condition stream)
(format stream "The machine ~A is not available."
(machine-error-machine-name condition)))))
(define-condition my-favorite-machine-not-available-error
(machine-not-available-error)
((machine-name :initform "mc.lcs.mit.edu")))
(define-condition ate-too-much (error)
((person :initarg :person :reader ate-too-much-person)
(weight :initarg :weight :reader ate-too-much-weight)
(kind-of-food :initarg :kind-of-food
:reader :ate-too-much-kind-of-food)))
→ ATE-TOO-MUCH
(define-condition ate-too-much-ice-cream (ate-too-much)
((kind-of-food :initform 'ice-cream)
(flavor :initarg :flavor
:reader ate-too-much-ice-cream-flavor
:initform 'vanilla ))
(:report (lambda (condition stream)
(format stream "~A ate too much ~A ice-cream"
(ate-too-much-person condition)
(ate-too-much-ice-cream-flavor condition)))))
→ ATE-TOO-MUCH-ICE-CREAM
(make-condition 'ate-too-much-ice-cream
:person 'fred
:weight 300
:flavor 'chocolate)
→ #<ATE-TOO-MUCH-ICE-CREAM 32236101>
(format t "~A" *)
\OUT FRED ate too much CHOCOLATE ice-cream
→ NIL
(defvar *oops-count* 0)
(setq a (make-condition 'simple-error
:format-control "This is your ~:R error."
:format-arguments (list (incf *oops-count*))))
→ #<SIMPLE-ERROR 32245104>
(format t "~&~A~%" a)
\OUT This is your first error.
→ NIL
(error a)
\OUT Error: This is your first error.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Return to Lisp Toplevel.
\OUT Debug>
;; One possible way in which an interactive debugger might present
;; restarts to the user.
(defun invoke-a-restart ()
(let ((restarts (compute-restarts)))
(do ((i 0 (+ i 1)) (r restarts (cdr r))) ((null r))
(format t "~&~D: ~A~%" i (car r)))
(let ((n nil) (k (length restarts)))
(loop (when (and (typep n 'integer) (>= n 0) (< n k))
(return t))
(format t "~&Option: ")
(setq n (read))
(fresh-line))
(invoke-restart-interactively (nth n restarts)))))
(restart-case (invoke-a-restart)
(one () 1)
(two () 2)
(nil () :report "Who knows?" 'anonymous)
(one () 'I)
(two () 'II))
\OUT 0: ONE
\OUT 1: TWO
\OUT 2: Who knows?
\OUT 3: ONE
\OUT 4: TWO
\OUT 5: Return to Lisp Toplevel.
\OUT Option: \IN{4}
→ II
;; Note that in addition to user-defined restart points, COMPUTE-RESTARTS
;; also returns information about any system-supplied restarts, such as
;; the "Return to Lisp Toplevel" restart offered above.
(restart-case
(let ((r (find-restart 'my-restart)))
(format t "~S is named ~S" r (restart-name r)))
(my-restart () nil))
\OUT #<RESTART 32307325> is named MY-RESTART
→ NIL
(find-restart 'my-restart)
→ NIL
(find-restart \param{identifier})
\EQ (find \param{identifier} (compute-restarts) :key :restart-name)
(defun add3 (x) (check-type x number) (+ x 3))
(foo 'seven)
\OUT Error: The value SEVEN was not of type NUMBER.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Specify a different value to use.
\OUT 2: Return to Lisp Toplevel.
\OUT Debug> \IN{(invoke-restart 'store-value 7)}
→ 10
(apply #'invoke-restart \i{restart} \i{arguments})
(defun add3 (x) (check-type x number) (+ x 3))
(add3 'seven)
\OUT Error: The value SEVEN was not of type NUMBER.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Specify a different value to use.
\OUT 2: Return to Lisp Toplevel.
\OUT Debug> \IN{(invoke-restart-interactively 'store-value)}
\OUT Type a form to evaluate and use: \IN{7}
→ 10
% (defun choose-an-interactive-restart ()
% (restart-bind
% ((optional-value
% #'(lambda (&optional (x 'default)) x)
% :report-function #'(lambda (stream)
% (format stream "Return an optional value")))\kern-3pt
% (return-value
% #'identity
% :report-function #'(lambda (stream)
% (format stream "Return the given value"))
% :interactive-function #'(lambda ()
% (format t "Enter a value to return: ")
% (list (eval (read))))))
% (let ((cases (compute-restarts))
% (*print-structure* t)
% (index -1))
% (dolist (case cases)
% (format t "~&~D: ~A~%" (incf index) case))
% (format t "Please enter restart to invoke: ")
% (invoke-restart-interactively (nth (eval (read)) cases)))))
%→\ CHOOSE-AN-INTERACTIVE-RESTART
% (choose-an-interactive-restart)
%→\ 0: Return an optional value
%1: Return the given value
%2: Abort to Lisp Top Level
%Please enter restart to invoke: 0
%DEFAULT
% (choose-an-interactive-restart)
%→\ 0: Return an optional value
%1: Return the given value
%2: Abort to Lisp Top Level
%Please enter restart to invoke: 1
%Enter a value to return: t
%T
%
(lambda (stream) (write-string value stream))
(format t "~&~S -- ~A~%" ':continue some-restart)
:CONTINUE -- Return to command level
(restart-case
(handler-bind ((error #'(lambda (c)
(declare (ignore condition))
(invoke-restart 'my-restart 7))))
(error "Foo."))
(my-restart (&optional v) v))
→ 7
(define-condition food-error (error) ())
→ FOOD-ERROR
(define-condition bad-tasting-sundae (food-error)
((ice-cream :initarg :ice-cream :reader bad-tasting-sundae-ice-cream)
(sauce :initarg :sauce :reader bad-tasting-sundae-sauce)
(topping :initarg :topping :reader bad-tasting-sundae-topping))
(:report (lambda (condition stream)
(format stream "Bad tasting sundae with ~S, ~S, and ~S"
(bad-tasting-sundae-ice-cream condition)
(bad-tasting-sundae-sauce condition)
(bad-tasting-sundae-topping condition)))))
→ BAD-TASTING-SUNDAE
(defun all-start-with-same-letter (symbol1 symbol2 symbol3)
(let ((first-letter (char (symbol-name symbol1) 0)))
(and (eql first-letter (char (symbol-name symbol2) 0))
(eql first-letter (char (symbol-name symbol3) 0)))))
→ ALL-START-WITH-SAME-LETTER
(defun read-new-value ()
(format t "Enter a new value: ")
(multiple-value-list (eval (read))))
→ READ-NEW-VALUE\eject
(defun verify-or-fix-perfect-sundae (ice-cream sauce topping)
(do ()
((all-start-with-same-letter ice-cream sauce topping))
(restart-case
(error 'bad-tasting-sundae
:ice-cream ice-cream
:sauce sauce
:topping topping)
(use-new-ice-cream (new-ice-cream)
:report "Use a new ice cream."
:interactive read-new-value
(setq ice-cream new-ice-cream))
(use-new-sauce (new-sauce)
:report "Use a new sauce."
:interactive read-new-value
(setq sauce new-sauce))
(use-new-topping (new-topping)
:report "Use a new topping."
:interactive read-new-value
(setq topping new-topping))))
(values ice-cream sauce topping))
→ VERIFY-OR-FIX-PERFECT-SUNDAE
(verify-or-fix-perfect-sundae 'vanilla 'caramel 'cherry)
\OUT Error: Bad tasting sundae with VANILLA, CARAMEL, and CHERRY.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Use a new ice cream.
\OUT 2: Use a new sauce.
\OUT 3: Use a new topping.
\OUT 4: Return to Lisp Toplevel.
\OUT Debug> \IN{:continue 1}
\OUT Use a new ice cream.
\OUT Enter a new ice cream: \IN{'chocolate}
→ CHOCOLATE, CARAMEL, CHERRY
(restart-case \i{expression}
(\i{name1} \i{arglist1} ...\i{options1}... . \i{body1})
(\i{name2} \i{arglist2} ...\i{options2}... . \i{body2}))
(block #1=#:g0001
(let ((#2=#:g0002 nil))
(tagbody
(restart-bind ((name1 #'(lambda (&rest temp)
(setq #2# temp)
(go #3=#:g0003))
...\i{slightly-transformed-options1}...)
(name2 #'(lambda (&rest temp)
(setq #2# temp)
(go #4=#:g0004))
...\i{slightly-transformed-options2}...))
(return-from #1# \i{expression}))
#3# (return-from #1#
(apply #'(lambda \i{arglist1} . \i{body1}) #2#))
#4# (return-from #1#
(apply #'(lambda \i{arglist2} . \i{body2}) #2#)))))
(restart-case (signal fred)
(a ...)
(b ...))
\EQ
(restart-case
(with-condition-restarts fred
(list (find-restart 'a)
(find-restart 'b))
(signal fred))
(a ...)
(b ...))
(restart-case
(loop for restart in (compute-restarts)
collect (restart-name restart))
(case1 () :report "Return 1." 1)
(nil () :report "Return 2." 2)
(case3 () :report "Return 3." 3)
(case1 () :report "Return 4." 4))
→ (CASE1 NIL CASE3 CASE1 ABORT)
;; In the example above the restart named ABORT was not created
;; explicitly, but was implicitly supplied by the system.
(defun read-eval-print-loop (level)
(with-simple-restart (abort "Exit command level ~D." level)
(loop
(with-simple-restart (abort "Return to command level ~D." level)
(let ((form (prog2 (fresh-line) (read) (fresh-line))))
(prin1 (eval form)))))))
→ READ-EVAL-PRINT-LOOP
(read-eval-print-loop 1)
(+ 'a 3)
\OUT Error: The argument, A, to the function + was of the wrong type.
\OUT The function expected a number.
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Specify a value to use this time.
\OUT 2: Return to command level 1.
\OUT 3: Exit command level 1.
\OUT 4: Return to Lisp Toplevel.
(defun compute-fixnum-power-of-2 (x)
(with-simple-restart (nil "Give up on computing 2{\hat}~D." x)
(let ((result 1))
(dotimes (i x result)
(setq result (* 2 result))
(unless (fixnump result)
(error "Power of 2 is too large."))))))
COMPUTE-FIXNUM-POWER-OF-2
(defun compute-power-of-2 (x)
(or (compute-fixnum-power-of-2 x) 'something big))
COMPUTE-POWER-OF-2
(compute-power-of-2 10)
1024
(compute-power-of-2 10000)
\OUT Error: Power of 2 is too large.
\OUT To continue, type :CONTINUE followed by an option number.
\OUT 1: Give up on computing 2{\hat}10000.
\OUT 2: Return to Lisp Toplevel
\OUT Debug> \IN{:continue 1}
→ SOMETHING-BIG
(defmacro with-simple-restart ((restart-name format-control
&rest format-arguments)
&body forms)
`(restart-case (progn ,@forms)
(,restart-name ()
:report (lambda (stream)
(format stream ,format-control ,@format-arguments))
(values nil t))))
(let ((x 3))
(handler-bind ((error #'(lambda (c)
(let ((r (find-restart 'continue c)))
(when r (invoke-restart r))))))
(cond ((not (floatp x))
(cerror "Try floating it." "~D is not a float." x)
(float x))
(t x)))) → 3.0
(defvar *all-quiet* nil) → *ALL-QUIET*
(defvar *saved-warnings* '()) → *SAVED-WARNINGS*
(defun quiet-warning-handler (c)
(when *all-quiet*
(let ((r (find-restart 'muffle-warning c)))
(when r
(push c *saved-warnings*)
(invoke-restart r)))))
→ CUSTOM-WARNING-HANDLER
(defmacro with-quiet-warnings (&body forms)
`(let ((*all-quiet* t)
(*saved-warnings* '()))
(handler-bind ((warning #'quiet-warning-handler))
,@forms
*saved-warnings*)))
→ WITH-QUIET-WARNINGS
(setq saved
(with-quiet-warnings
(warn "Situation #1.")
(let ((*all-quiet* nil))
(warn "Situation #2."))
(warn "Situation #3.")))
\OUT Warning: Situation #2.
→ (#<SIMPLE-WARNING 42744421> #<SIMPLE-WARNING 42744365>)
(dolist (s saved) (format t "~&~A~%" s))
\OUT Situation #3.
\OUT Situation #1.
→ NIL
(defun type-error-auto-coerce (c)
(when (typep c 'type-error)
(let ((r (find-restart 'store-value c)))
(handler-case (let ((v (coerce (type-error-datum c)
(type-error-expected-type c))))
(invoke-restart r v))
(error ()))))) → TYPE-ERROR-AUTO-COERCE
(let ((x 3))
(handler-bind ((type-error #'type-error-auto-coerce))
(check-type x float)
x)) → 3.0
;;; Example of the ABORT retart
(defmacro abort-on-error (&body forms)
`(handler-bind ((error #'abort))
,@forms)) → ABORT-ON-ERROR
(abort-on-error (+ 3 5)) → 8
(abort-on-error (error "You lose."))
\OUT Returned to Lisp Top Level.
;;; Example of the CONTINUE restart
(defun real-sqrt (n)
(when (minusp n)
(setq n (- n))
(cerror "Return sqrt(~D) instead." "Tried to take sqrt(-~D)." n))
(sqrt n))
(real-sqrt 4) → 2
(real-sqrt -9)
\OUT Error: Tried to take sqrt(-9).
\OUT To continue, type :CONTINUE followed by an option number:
\OUT 1: Return sqrt(9) instead.
\OUT 2: Return to Lisp Toplevel.
\OUT Debug> \IN{(continue)}
\OUT Return sqrt(9) instead.
→ 3
(handler-bind ((error #'(lambda (c) (continue))))
(real-sqrt -9)) → 3
;;; Example of the MUFFLE-WARNING restart
(defun count-down (x)
(do ((counter x (1- counter)))
((= counter 0) 'done)
(when (= counter 1)
(warn "Almost done"))
(format t "~&~D~%" counter)))
→ COUNT-DOWN
(count-down 3)
\OUT 3
\OUT 2
\OUT Warning: Almost done
\OUT 1
→ DONE
(defun ignore-warnings-while-counting (x)
(handler-bind ((warning #'ignore-warning))
(count-down x)))
→ IGNORE-WARNINGS-WHILE-COUNTING
(defun ignore-warning (condition)
(declare (ignore condition))
(muffle-warning))